Rでポケモンスタンプラリー(3/3) {TSP}で巡回セールスマン問題
estrellita.hatenablog.comの続き。最後は{TSP}
を利用して移動距離が最短となるようスタンプ設置駅を周回する順番を求める。
- データ準備
- 路線ネットワークに必要なノードとエッジのデータを作成
{tidygraph}
でスタンプ設置駅間の最短経路探索- 路線ネットワークデータからスタンプ設置駅の最短距離を探索
{TSP}
で巡回セールスマン問題を解く( ← イマココ)- 各スタンプ設置駅間の距離行列から移動距離が最短となるような巡回順を探索
目次
距離行列の作成
グラフオブジェクトからノード情報を取り出し、スタンプ設置駅間の距離行列を作成する。
dist <- g %>% tidygraph::activate(nodes) %>% dplyr::as_tibble() %>% dplyr::filter(station_name %in% stamp$name_j) %>% dplyr::inner_join(stamp, by = c("station_name" = "name_j")) %>% dplyr::select(name_e, dplyr::starts_with("dist_")) %>% tidyr::gather(key = to, value = dist, -name_e) %>% dplyr::mutate(to = stringr::str_replace(to, "dist_", "")) %>% dplyr::rename(from = name_e) %>% dplyr::arrange(from, to) %>% tidyr::spread(key = to, value = dist) dist.mat <- dist %>% dplyr::select(-from) %>% as.matrix() row.names(dist.mat) <- dist$from dist.mat %>% head() %>% knitr::kable()
Ageo | Akabane | Akihabara | Chiba | Hachioji | (略) | |
---|---|---|---|---|---|---|
Ageo | 0.00 | 24853.35 | 35129.083 | 67556.56 | 53902.27 | (略) |
Akabane | 24853.35 | 0.00 | 10275.730 | 42703.20 | 42151.29 | (略) |
Akihabara | 35129.08 | 10275.73 | 0.000 | 34311.47 | 41289.58 | (略) |
Chiba | 67556.56 | 42703.20 | 34311.466 | 0.00 | 72618.62 | (略) |
Hachioji | 53902.27 | 42151.29 | 41289.578 | 72618.62 | 0.00 | (略) |
Hamatsucho | 39551.71 | 15071.80 | 5023.122 | 35293.64 | 41574.01 | (略) |
巡回セールスマン問題
スタンプ設置駅間の距離行列ができたので、TSP::solve_TSP()
で最適な巡回順を求める。TSP::solve_TSP()
で指定できるmethod
は
- nearest_insertion
- cheapest_insertion
- farthest_insertion
- arbitrary_insertion
- nn
- repetitive_nn
- 2-opt
などを指定できるので一応全て試してみる。
methods <- c( "nearest_insertion", "cheapest_insertion", "farthest_insertion", "arbitrary_insertion", "nn", "repetitive_nn", "2-opt" ) ans <- list() for(i in seq_along(methods)) { set.seed(123) ans[[i]] <- TSP::solve_TSP(x = TSP::TSP(dist.mat), method = methods[i]) } names(ans) <- methods ans $nearest_insertion object of class ‘TOUR’ result of method ‘nearest_insertion’ for 43 cities tour length: 442142.4 $cheapest_insertion object of class ‘TOUR’ result of method ‘cheapest_insertion’ for 43 cities tour length: 441402.5 $farthest_insertion object of class ‘TOUR’ result of method ‘farthest_insertion’ for 43 cities tour length: 415361.3 $arbitrary_insertion object of class ‘TOUR’ result of method ‘arbitrary_insertion’ for 43 cities tour length: 443430.7 $nn object of class ‘TOUR’ result of method ‘nn’ for 43 cities tour length: 444514.4 $repetitive_nn object of class ‘TOUR’ result of method ‘repetitive_nn’ for 43 cities tour length: 432325.2 $`2-opt` object of class ‘TOUR’ result of method ‘2-opt’ for 43 cities tour length: 447620.1
今回はfarthest_insertion
が最も距離が短い結果となった。
結果の確認
結果を確認してみる。
ind <- ans$farthest_insertion %>% as.vector() row.names(dist.mat)[ind] [1] "Shibuya" "Meguro" [3] "Shinagawa" "Tamachi" [5] "Hamatsucho" "Haneda-Airport-International-Terminal" [7] "Kamata" "Kawasaki" [9] "Yokohama" "Sakuragicho" [11] "Higashi-Totsuka" "Ofuna" [13] "Hachioji" "Tachikawa" [15] "Kichijoji" "Nishi-Ogikubo" [17] "Nakano" "Ikebukuro" [19] "Itabashi" "Akabane" [21] "Musashi-Urawa" "Hasuda" [23] "Omiya" "Ageo" [25] "Koshigaya-Laketown" "Kashiwa" [27] "Toride" "Ushiku" [29] "Matsudo" "Tsudanuma" [31] "Chiba" "Shin-Urayasu" [33] "Tokyo" "Kanda" [35] "Kinshicho" "Ryogoku" [37] "Akihabara" "Ueno" [39] "Kita-Senju" "Nippori" [41] "Sugamo" "Ichigaya" [43] "Shinjuku"
渋谷 → 目黒 → 品川 → 田町 → 浜松町 → 羽田空港国際線ビル → 蒲田 → 川崎 → 横浜 → 桜木町 → 東戸塚 → 大船 → 八王子 → 立川 → 吉祥寺 → 西荻窪 → 中野 → 池袋 → 板橋 → 赤羽 → 武蔵浦和 → 蓮田 → 大宮 → 上尾 → 越谷レイクタウン → 柏 → 取手 → 牛久 → 松戸 → 津田沼 → 千葉 → 新浦安 → 東京 → 神田 → 錦糸町 → 両国 → 秋葉原 → 上の → 北千住 → 日暮里 → 巣鴨 → 市ヶ谷 → 新宿
という順で周るのが最短らしい。
{leaflet}
で可視化してみると以下のようになる。
tibble(name_e = row.names(dist.mat)[ind]) %>% dplyr::inner_join(stamp, by = "name_e") %>% dplyr::inner_join(node, by = c("name_j" = "station_name")) %>% dplyr::mutate(lon = as.numeric(lon), lat = as.numeric(lat)) %>% leaflet::leaflet() %>% leaflet::addTiles() %>% leaflet::addPolylines(lng = ~lon, lat = ~lat) %>% leaflet::addMarkers(lat = ~lat, lng = ~lon, popup = ~name_j)
見た感じ良さそう!
大船 〜 八王子間が離れすぎているように感じるため念の為確認してみる。
ofuna2hachioji <- g %>% tidygraph::morph(tidygraph::to_shortest_path, from, to, weights = dist) %>% dplyr::mutate(selected_node = TRUE) %>% tidygraph::activate(edges) %>% dplyr::mutate(selected_edge = TRUE) %>% tidygraph::unmorph() %>% tidygraph::activate(nodes) %>% dplyr::mutate(selected_node = ifelse(is.na(selected_node), 0, 1)) %>% tidygraph::activate(edges) %>% dplyr::mutate(selected_edge = ifelse(is.na(selected_edge), 0, 1)) %>% dplyr::arrange(selected_edge) ofuna2hachioji %>% ggraph::ggraph(layout = "manual", node.position = coord) + ggraph::geom_node_text(ggplot2::aes(label = station_name, color = line_cd, alpha = selected_node), size = 3, show.legend = FALSE, family = "HiraKakuPro-W3") + ggraph::geom_edge_diagonal(ggplot2::aes(alpha = selected_edge), color = "gray")
見たところ以下のように乗り継いでいるようだ。ダイヤによっては大船 〜 横浜、横浜 〜 八王子の方が楽かもしれない。
というわけでネットワーク分析と巡回サラリーマン問題を組み合わせて、効率的にポケモンスタンプラリーを周ることができそうだ。今回は隣接駅の直線距離のみで計算しており路線のダイヤは考慮できていない。今後鉄道にもGTFSが普及し、MaaSプラットフォームが充実することでより効率的に巡回できる世の中になることを期待したい。