INPUTしたらOUTPUT!

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

Rでポケモンスタンプラリー(1/3) データ準備編

R

最後のー 休みがー 今年もー 終わったなー♪


9月に入り、今年の夏休みも終わりましたがみなさまいかがお過ごしでしょうか。 夏休みの風物詩といえばJR東日本が毎年催すポケモンスタンプラリー。

https://www.jreast.co.jp/press/2019/tokyo/20190628_to02.pdf


昨年より減ったものの43駅あるので全ての駅を制覇しようとするといかに効率的に回るかよく考える必要があり、それだけで酒が呑める！という方々と最近を仕事をしているのですが自分はそこまで鉄道に興味がないのでRで楽したい。というわけで以下の流れでスタンプ設置駅間の移動距離が最小となるように巡回セールスマン問題で解いて巡回する順番を求める。


  1. データ準備（ ← イマココ）
    • 路線ネットワークに必要なノードとエッジのデータを作成
  2. {tidygraph}でスタンプ設置駅間の最短経路探索
    • 路線ネットワークデータからスタンプ設置駅の最短距離を探索
  3. {TSP}で巡回セールスマン問題を解く
    • 各スタンプ設置駅間の距離行列から移動距離が最短となるような巡回順を探索


目次


データの取得

駅間の距離は国土数値情報で公開されているポリゴンから計算したかったが、うまく駅間のLineStringに分割できなかった。。。


そのため駅データ.jpの隣接駅APIで取得できる緯度・経度から直線距離を計算し、移動距離とする。


路線情報の取得

隣接駅APIは路線コードを指定する必要があるため、都道府県APIから都道府県ごとに路線コードを取得する。

library(dplyr)

# 茨城、埼玉、千葉、東京、神奈川の路線情報を取得
line <- glue::glue("http://www.ekidata.jp/api/p/{pref}.xml", pref = c(8, seq(11, 14, 1))) %>%
  purrr::map(xml2::read_xml) %>%
  purrr::map(xml2::xml_find_all, xpath = "//line") %>% 
  purrr::flatten() %>% 
  purrr::map(xml2::as_list) %>% 
  purrr::map_dfr(~.[c("line_cd", "line_name")]) %>% 
  purrr::map_dfr(unlist) %>% 
  dplyr::arrange(line_cd) %>%
  dplyr::distinct()

line %>% 
  head() %>% 
  knitr::kable()
line_cd line_name
11229 JR常磐線(取手～いわき)
11301 JR東海道本線(東京～熱海)
11302 JR山手線
11303 JR南武線
11304 JR鶴見線
11305 JR武蔵野線


隣接駅情報を取得

同様に隣接駅APIを実行して隣接駅の情報を取得する。路線情報と同様に処理をしようとすると処理が止まってしまったため、1路線取得するごとに2秒間待機するように関数化する。

get_station_join <- function(line_cd) {
  message(Sys.time() , " ", line_cd)
  Sys.sleep(2)
  glue::glue("http://www.ekidata.jp/api/n/{line_cd}.xml") %>% 
    xml2::read_xml() %>%
    xml2::xml_find_all(xpath = "//station_join") %>%
    xml2::as_list() %>%
    purrr::map_dfr(~.[c("station_cd1", "lon1", "lat1", "station_cd2", "lon2", "lat2")]) %>%
    purrr::map_dfr(unlist) %>% 
    dplyr::mutate(line_cd = line_cd)
}

station_join <- line$line_cd %>% 
  purrr::map_dfr(get_station_join)

station_join %>% 
  head() %>% 
  knitr::kable()
station_cd1 lon1 lat1 station_cd2 lon2 lat2 line_cd
1122934 140.855005 37.035895 1122935 140.892273 37.058241 11229
1122933 140.849884 37.006922 1122934 140.855005 37.035895 11229
1122932 140.854125 36.955602 1122933 140.849884 37.006922 11229
1122931 140.796468 36.920649 1122932 140.854125 36.955602 11229
1122930 140.786506 36.883883 1122931 140.796468 36.920649 11229
1122929 140.778001 36.846085 1122930 140.786506 36.883883 11229


乗り換え駅データの取得

隣接駅情報は同名の駅でも路線ごとにstation_cdを採番しているため、隣接駅情報をそのままネットワークグラフに変換すると乗り換え駅が別ノードとなってしまう。駅データ.jpでは以下の条件のどちらかにあてはまる場合、乗り換え駅として同一のstation_g_cdを設定しているため、station_g_cdを含む駅情報を路線APIから取得する。

  • 同一改札内の駅
  • 改札が異なっていても乗換可能な駅
get_station <- function(line_cd) {
  message(Sys.time() , " ", line_cd)
  Sys.sleep(2)
  glue::glue("http://www.ekidata.jp/api/l/{line_cd}.xml") %>% 
    xml2::read_xml() %>%
    xml2::xml_find_all(xpath = "//station") %>%
    xml2::as_list() %>%
    purrr::map_dfr(~.[c("station_cd", "station_g_cd", "station_name", "lon", "lat")]) %>%
    purrr::map_dfr(unlist) %>% 
    dplyr::mutate(line_cd = line_cd)
}

station <- line$line_cd %>% 
  purrr::map_dfr(get_station)

station %>% 
  head() %>% 
  knitr::kable()
station_cd station_g_cd station_name lon lat line_cd
1122901 1122901 取手 140.063004 35.89553 11229
1122902 1122902 藤代 140.118251 35.920565 11229
1122903 1122903 佐貫 140.138217 35.930066 11229
1122904 1122904 牛久 140.141039 35.975314 11229
1122905 1122905 ひたち野うしく 140.158408 36.007996 11229
1122906 1122906 荒川沖 140.16592 36.030552 11229


ネットワークデータの作成

スタンプ設置駅のデータ作成

あとでスタンプ設置駅間の最短距離を計算するため、スタンプ設置駅のリストを作成する。

stamp <- dplyr::tribble(
  ~area, ~name_j, ~name_e, ~pokemon,
  "mew", "上尾", "Ageo", "ゼニガメ",
  "mew", "池袋", "Ikebukuro", "ミュウ",
  "mew", "板橋", "Itabashi", "フシギダネ",
  "mew", "大宮", "Omiya", "リザードン",
  "mew", "川崎", "Kawasaki", "ロコン",
  "mew", "吉祥寺", "Kichijoji", "カメックス",
  "mew", "桜木町", "Sakuragicho", "ピカチュウ",
  "mew", "渋谷", "Shibuya", "プクリン",
  "mew", "新宿", "Shinjuku", "コダック",
  "mew", "立川", "Tachikawa", "ヒトカゲ",
  "mew", "中野", "Nakano", "ジュゴン",
  "mew", "蓮田", "Hasuda", "ピジョット",
  "mew", "八王子", "Hachioji", "ヒトデマン",
  "mew", "東戸塚", "Higashi-Totsuka", "ギャラドス",
  "mew", "武蔵浦和", "Musashi-Urawa", "フシギバナ",
  "mew", "目黒", "Meguro", "トゲピー",
  "mew", "横浜", "Yokohama", "ニャース",
  "mewtwo", "秋葉原", "Akihabara", "カメックス",
  "mewtwo", "牛久", "Ushiku", "ギャラドス",
  "mewtwo", "柏", "Kashiwa", "フシギダネ",
  "mewtwo", "神田", "Kanda", "フシギバナ",
  "mewtwo", "北千住", "Kita-Senju", "ピジョット",
  "mewtwo", "錦糸町", "Kinshicho", "ヒトカゲ",
  "mewtwo", "越谷レイクタウン", "Koshigaya-Laketown", "プクリン",
  "mewtwo", "新浦安", "Shin-Urayasu", "ジュゴン",
  "mewtwo", "巣鴨", "Sugamo", "コダック",
  "mewtwo", "田町", "Tamachi", "ピカチュウ",
  "mewtwo", "津田沼", "Tsudanuma", "アーマードミュウツー",
  "mewtwo", "東京", "Tokyo", "ミュウツー",
  "mewtwo", "取手", "Toride", "ロコン",
  "mewtwo", "日暮里", "Nippori", "ニャース",
  "mewtwo", "羽田空港国際線ビル", "Haneda-Airport-International-Terminal", "カイリュー",
  "mewtwo", "浜松町", "Hamatsucho", "リザードン",
  "mewtwo", "両国", "Ryogoku", "ゼニガメ",
  "trainers", "赤羽", "Akabane", "ソラオ",
  "trainers", "市ヶ谷", "Ichigaya", "サトシ",
  "trainers", "上野", "Ueno", "コジロウ",
  "trainers", "大船", "Ofuna", "ウミオ",
  "trainers", "蒲田", "Kamata", "タケシ",
  "trainers", "品川", "Shinagawa", "カスミ",
  "trainers", "千葉", "Chiba", "サカキ",
  "trainers", "西荻窪", "Nishi-Ogikubo", "スイート",
  "trainers", "松戸", "Matsudo", "ムサシ"
)

stamp %>% 
  head() %>% 
  knitr::kable()
area name_j name_e pokemon
mew 上尾 Ageo ゼニガメ
mew 池袋 Ikebukuro ミュウ
mew 板橋 Itabashi フシギダネ
mew 大宮 Omiya リザードン
mew 川崎 Kawasaki ロコン
mew 吉祥寺 Kichijoji カメックス


ノード情報の作成

前述の通り、駅コードをノードにすると乗り換え駅が別ノードとなるため駅グループコードを元にノード情報を作成する。駅情報からstation_g_cdごとに路線コードで並べ替え、各駅グループの最初のレコードを駅グループの代表レコードとする。この時、駅グループにJR東日本のスタンプ設置駅が含まれる場合はJR東日本の駅を優先する。

node <- station %>% 
  dplyr::mutate(is.target = if_else(station_name %in% stamp$name_j, 1, 0)) %>% 
  dplyr::group_by(station_g_cd) %>% 
  dplyr::arrange(station_g_cd, desc(is.target), line_cd) %>% 
  dplyr::mutate(row_num = dplyr::row_number()) %>% 
  dplyr::ungroup() %>% 
  dplyr::filter(row_num == 1) %>% 
  dplyr::select(station_g_cd, station_name, line_cd, lon, lat)

node %>% 
  head() %>% 
  knitr::kable()
station_g_cd station_name line_cd lon lat
1122801 いわき 11229 140.892273 37.058241
1122901 取手 11229 140.063004 35.89553
1122902 藤代 11229 140.118251 35.920565
1122903 佐貫 11229 140.138217 35.930066
1122904 牛久 11229 140.141039 35.975314
1122905 ひたち野うしく 11229 140.158408 36.007996


エッジ情報の作成

隣接駅情報で2駅の緯度・経度が取得できているため、以下の流れで駅間の距離を計算する。

  1. 緯度・経度からsf::st_point()でsfオブジェクトに変換
  2. 駅データ.jpの測地系WGS84から平面直角座標系に変換
  3. sf::st_distance()で駅間の距離を計算
  4. 駅コードから駅グループコードに変換


東京付近のため平面直角座標系のSRIDは2451を設定していますが他の地域で行う際は変更する必要がある。*1

station_join <- readRDS("data/station_join.rds")

edge <- station_join %>% 
  dplyr::mutate_at(vars(matches("lon|lat")), as.numeric) %>%
  # 緯度・経度からsfオブジェクトを作成
  dplyr::mutate(coord1 = purrr::map2(.x = lon1, .y = lat1, .f = c),
                coord2 = purrr::map2(.x = lon2, .y = lat2, .f = c)) %>% 
  dplyr::mutate(coord1 = purrr::map(.x = coord1, .f = sf::st_point, dim = "XY"),
                coord2 = purrr::map(.x = coord2, .f = sf::st_point, dim = "XY")) %>% 
  # WGS84から平面直角座標系に変換
  dplyr::mutate(coord1 = sf::st_as_sfc(coord1) %>% 
                  sf::st_set_crs(4326) %>% 
                  sf::st_transform(2451),
                coord2 = sf::st_as_sfc(coord2) %>% 
                  sf::st_set_crs(4326) %>% 
                  sf::st_transform(2451)) %>% 
  # 駅間の距離を計算
  dplyr::mutate(dist = purrr::map2_dbl(.x = coord1, .y = coord2, .f = sf::st_distance)) %>% 
  dplyr::select(station_cd1, station_cd2, line_cd, dist) %>% 
  # 駅グループコードに変換
  dplyr::inner_join(station, by = c("station_cd1" = "station_cd")) %>% 
  dplyr::inner_join(station, by = c("station_cd2" = "station_cd")) %>% 
  dplyr::select(station_g_cd.x, station_g_cd.y, line_cd, dist) %>% 
  dplyr::rename(from = station_g_cd.x,
                to = station_g_cd.y)
from to line_cd dist
1122934 1122801 11229 4140.174
1122933 1122934 11229 3247.503
1122932 1122933 11229 5707.865
1122931 1122932 11229 6436.428
1122930 1122931 11229 4175.580
1122929 1122930 11229 4262.592


ネットワークデータに必要なノードとエッジの準備ができたので、次は{tidygraph}を利用してスタンプ設置駅間の最短距離を計算する。


*1:参考: PostGISでよく使うSRIDまとめ : してログ - LANDHERE