Rで自作関数:get_estat_list

library(dplyr)
library(httr2)

# 文字列、または「$」を持つ要素から文字列を取り出す
text_of <- function(z) {
  if (is.null(z)) {
    return(NA_character_)
  }
  if (is.list(z)) z <- z[["$"]]
  if (is.null(z)) NA_character_ else as.character(z)
}

# 属性(@で始まる名前)を取り出す
attr_of <- function(z, name) {
  if (is.list(z) && !is.null(z[[name]])) as.character(z[[name]]) else NA_character_
}

# e-Stat APIの呼び出し:エラー時は結果コードとメッセージを表示して停止する
call_estat <- function(api, params, root) {
  res <- request(paste0("https://api.e-stat.go.jp/rest/3.0/app/json/", api)) |>
    req_url_query(!!!params) |>
    req_user_agent("r-estat-client") |>
    req_retry(max_tries = 3) |>
    req_error(is_error = function(resp) FALSE) |>
    req_perform()
  body <- tryCatch(resp_body_json(res, check_type = FALSE), error = function(e) NULL)
  x <- body[[root]]
  if (is.null(x)) {
    stop(
      "e-Stat APIの応答を解釈できません(HTTP ", resp_status(res), "): ",
      substr(resp_body_string(res), 1, 300)
    )
  }
  status <- as.integer(x[["RESULT"]][["STATUS"]])
  if (status >= 100) {
    stop("e-Stat APIのエラー(結果コード ", status, "): ", x[["RESULT"]][["ERROR_MSG"]])
  }
  x
}

# 統計表情報(getStatsList)の応答を表にする
table_inf_to_tibble <- function(tbl) {
  col <- function(f) vapply(tbl, f, character(1))
  tibble(
    stats_data_id = col(function(z) attr_of(z, "@id")),
    stats_code = col(function(z) attr_of(z[["STAT_NAME"]], "@code")),
    stat_name = col(function(z) text_of(z[["STAT_NAME"]])),
    gov_org = col(function(z) text_of(z[["GOV_ORG"]])),
    statistics_name = col(function(z) text_of(z[["STATISTICS_NAME"]])),
    table_no = col(function(z) attr_of(z[["TITLE"]], "@no")),
    title = col(function(z) text_of(z[["TITLE"]])),
    cycle = col(function(z) text_of(z[["CYCLE"]])),
    survey_date = col(function(z) text_of(z[["SURVEY_DATE"]])),
    open_date = col(function(z) text_of(z[["OPEN_DATE"]])),
    collect_area = col(function(z) text_of(z[["COLLECT_AREA"]])),
    main_category = col(function(z) text_of(z[["MAIN_CATEGORY"]])),
    sub_category = col(function(z) text_of(z[["SUB_CATEGORY"]])),
    total_number = suppressWarnings(
      as.numeric(col(function(z) text_of(z[["OVERALL_TOTAL_NUMBER"]])))
    ),
    updated_date = col(function(z) text_of(z[["UPDATED_DATE"]]))
  )
}

# e-Stat API:統計表の一覧を取得(statsDataIdを探す) ---------------------------
get_estat_list <- function(app_id, search_word = NULL, stats_code = NULL,
                           survey_years = NULL, open_years = NULL,
                           stats_field = NULL, collect_area = NULL,
                           updated_date = NULL, limit = 1000, max_pages = 10) {
  if (!nzchar(app_id)) stop("御自身のアプリケーションIDを設定して下さい")
  opt <- list(
    searchWord = search_word, statsCode = stats_code,
    surveyYears = survey_years, openYears = open_years,
    statsField = stats_field, collectArea = collect_area,
    updatedDate = updated_date
  )
  p <- c(
    list(appId = app_id, lang = "J", limit = limit, explanationGetFlg = "N"),
    Filter(Negate(is.null), opt)
  )
  out <- list()
  for (i in seq_len(max_pages)) {
    x <- call_estat("getStatsList", p, "GET_STATS_LIST")
    inf <- x[["DATALIST_INF"]]
    tbl <- inf[["TABLE_INF"]]
    if (is.null(tbl)) break
    # 1件だけのときは配列ではなく単独の要素で返るため、リストに包む
    if (!is.null(tbl[["@id"]])) tbl <- list(tbl)
    out[[i]] <- table_inf_to_tibble(tbl)
    next_key <- inf[["RESULT_INF"]][["NEXT_KEY"]]
    if (is.null(next_key)) break
    if (i == max_pages) {
      warning("max_pagesに達しました。続きがあります(NEXT_KEY=", next_key, ")")
    }
    p$startPosition <- next_key
    Sys.sleep(1) # サーバー負荷軽減のため待機
  }
  if (length(out) == 0) {
    message("該当する統計表はありませんでした")
    return(table_inf_to_tibble(list()))
  }
  bind_rows(out)
}