INPUTしたらOUTPUT!

忘れっぽいんでメモっとく

Rでポケモンスタンプラリー(3/3) {TSP}で巡回セールスマン問題

estrellita.hatenablog.comの続き。最後は{TSP}を利用して移動距離が最短となるようスタンプ設置駅を周回する順番を求める。


  1. データ準備
    • 路線ネットワークに必要なノードとエッジのデータを作成
  2. {tidygraph}でスタンプ設置駅間の最短経路探索
    • 路線ネットワークデータからスタンプ設置駅の最短距離を探索
  3. {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)

f:id:tak95:20190908225038p:plain

見た感じ良さそう!


大船 〜 八王子間が離れすぎているように感じるため念の為確認してみる。

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")

f:id:tak95:20190908232242p:plain

見たところ以下のように乗り継いでいるようだ。ダイヤによっては大船 〜 横浜、横浜 〜 八王子の方が楽かもしれない。



というわけでネットワーク分析と巡回サラリーマン問題を組み合わせて、効率的にポケモンスタンプラリーを周ることができそうだ。今回は隣接駅の直線距離のみで計算しており路線のダイヤは考慮できていない。今後鉄道にもGTFSが普及し、MaaSプラットフォームが充実することでより効率的に巡回できる世の中になることを期待したい。