Rで自作関数:ksj_station_passenger_data_parser

ksj_station_passenger_data_parser <- function(xml_file){
  
# 国土数値情報（駅別乗降客数）のxmlデータ をデータフレームに変換する
# 必要パッケージ: xml2

library(xml2)

# -------------------------------------------------------
# 1. ファイル読み込み
# -------------------------------------------------------
doc <- read_xml(xml_file)

# -------------------------------------------------------
# 2. 名前空間の定義
# -------------------------------------------------------
ns <- c(
  ksj   = "http://nlftp.mlit.go.jp/ksj/schemas/ksj-app",
  gml   = "http://www.opengis.net/gml/3.2",
  xlink = "http://www.w3.org/1999/xlink"
)

# -------------------------------------------------------
# 3. gml:Curve から緯度・経度を抽出
# -------------------------------------------------------
# posList には複数の座標ペア（緯度 経度 緯度 経度 ...）が入っているため、
# 全座標の平均値を代表点（中点）として使用する

curves <- xml_find_all(doc, "//gml:Curve", ns)

coords_df <- do.call(rbind, lapply(curves, function(cv) {
  cv_id    <- xml_attr(cv, "id")
  pos_node <- xml_find_first(cv, ".//gml:posList", ns)
  pos_text <- xml_text(pos_node)
  vals     <- as.numeric(strsplit(trimws(pos_text), "\\s+")[[1]])
  # 座標順は「緯度 経度 緯度 経度 ...」
  lat_vals  <- vals[seq(1, length(vals), by = 2)]
  lon_vals  <- vals[seq(2, length(vals), by = 2)]
  data.frame(
    cv_id     = cv_id,
    latitude  = mean(lat_vals),
    longitude = mean(lon_vals),
    stringsAsFactors = FALSE
  )
}))

# -------------------------------------------------------
# 4. 駅ノードを取得
# -------------------------------------------------------
stations <- xml_find_all(
  doc,
  "//ksj:TheNumberofTheStationPassengersGettingonandoff",
  ns
)

# -------------------------------------------------------
# 5. 各ノードからフィールドを抽出するヘルパー関数
# -------------------------------------------------------
get_text <- function(node, xpath, ns) {
  result <- xml_find_first(node, xpath, ns)
  if (is.na(result)) return(NA_character_)
  xml_text(result)
}

# -------------------------------------------------------
# 6. 乗降客数の年リストを動的に取得
# -------------------------------------------------------
# 最初の駅ノードの子要素名から passengerYYYY タグを特定する
# （XPathのワイルドカード * は属性・名前空間付きノードに非対応のため）
first_station  <- stations[[1]]
child_names    <- xml_name(xml_children(first_station))
passenger_tags <- child_names[grepl("^passengers\\d{4}$", child_names)]
years <- sort(as.integer(sub("passengers", "", passenger_tags)))

# -------------------------------------------------------
# 7. 駅データフレームの構築
# -------------------------------------------------------
records <- lapply(stations, function(node) {

  # station_ref は "#cv1" の形式 → "#" を除いて cv_id とする
  station_href <- xml_attr(xml_find_first(node, "ksj:station", ns), "href")
  cv_id <- sub("^#", "", station_href)

  base <- list(
    gml_id                        = xml_attr(node, "id"),
    cv_id                         = cv_id,
    stationName                   = get_text(node, "ksj:stationName",                   ns),
    stationCode                   = get_text(node, "ksj:stationCode",                   ns),
    groupCode                     = get_text(node, "ksj:groupCode",                     ns),
    administrationCompany         = get_text(node, "ksj:administrationCompany",         ns),
    routeName                     = get_text(node, "ksj:routeName",                     ns),
    railroadDivision              = get_text(node, "ksj:railroadDivision",              ns),
    railroadCompanyClassification = get_text(node, "ksj:railroadCompanyClassification", ns)
  )

  # 年別乗降客数
  pax <- lapply(years, function(yr) {
    as.integer(get_text(node, paste0("ksj:passengers", yr), ns))
  })
  names(pax) <- paste0("passengers", years)

  c(base, pax)
})

df_stations <- as.data.frame(
  do.call(rbind, lapply(records, as.data.frame, stringsAsFactors = FALSE)),
  stringsAsFactors = FALSE
)

# 乗降客数列を整数型に変換
int_cols <- grep("^passengers", names(df_stations), value = TRUE)
df_stations[int_cols] <- lapply(df_stations[int_cols], as.integer)

# -------------------------------------------------------
# 8. 緯度・経度を cv_id で結合
# -------------------------------------------------------
df <- merge(df_stations, coords_df, by = "cv_id", all.x = TRUE)

# 列順を整える（cv_id の直後に latitude / longitude が来るように）
col_order <- c("gml_id", "cv_id", "latitude", "longitude",
               "stationName", "stationCode", "groupCode",
               "administrationCompany", "routeName",
               "railroadDivision", "railroadCompanyClassification",
               paste0("passengers", years))
df <- df[, col_order]

# gml_id の番号順にソート
df <- df[order(as.integer(sub("sp", "", df$gml_id))), ]
rownames(df) <- NULL

# df を返す
return(df)
  
}