R/read_jma.R

In whatalnk/readjma: Read climate data from Japan Meteorological Agency web site

#' generate body for POST
#'
#' @param from Date
#' @param to Date
#' @param phpsessid php session id generated by get_phpsessionid()
body_read_jma <- function(from, to, phpsessid){
  list(
    "stationNumList" = "[\"a0593\"]",
    "aggrgPeriod" = 9,
    "elementNumList" = "[[\"201\",\"\"],[\"101\",\"\"]]",
    "interAnnualFlag" = 1,
    "ymdList" = str_glue("[\"{year(from)}\",\"{year(to)}\",\"{month(from)}\",\"{month(to)}\",\"{day(from)}\",\"{day(from)}\"]"),
    "optionNumList" = "[]",
    "downloadFlag" = "true",
    "rmkFlag" = 1,
    "disconnectFlag" = 1,
    "youbiFlag"= 0,
    "fukenFlag" = 0,
    "kijiFlag" = 0,
    "huukouFlag" = 0,
    "csvFlag" = 1,
    "jikantaiFlag" = 0,
    "jikantaiList" = "[1,24]",
    "ymdLiteral" = 1,
    "PHPSESSID" = phpsessid
  )
}

#' read csv data from jma web site
#' @param from Date
#' @param to Date
#' @param phpsessid php session id obtained by `get_phpsessionid()`
#'@return csv data (character), can be processed with `readr::read_csv()`
#'
read_jma_monthly <- function(from, to, phpsessid){
  url <- "http://www.data.jma.go.jp/gmd/risk/obsdl/show/table"
  body <- body_read_jma(from, to, phpsessid)
  resp <- POST(url, body = body, encode = "form")
  if (http_type(resp) != "text/x-comma-separated-values"){
    warning(str_glue("Responce is not csv: from {from} to {to}"))
    return(NA)
  }
  csv <- resp %>%
    content(as = "text", encoding="SJIS")
  csv
}

#' read csv data from jma web site
#' @param from Date
#' @param to Date
#' @param phpsessid php session id obtained by `get_phpsessionid()`
#' @param wait wait for given time after POST
#'@return list of csv data (character), each csv can be processed with `readr::read_csv()`
#' @examples
#' library("lubridate")
#' library("readr")
#' library("purrr")
#' library("dplyr")
#'
#' phpsessid <- get_phpsessionid()
#'
#' # Site: Fukuchiyama, Kyoto
#' # Interval: from 2018-01-01 to 2018-12-31
#' # Data: Temperature and Precipitation
#'
#' f <- read_jma(ymd("2018-01-01"), ymd("2018-12-31"), phpsessid)
#'
#' # parse csv using readr
#' col_names <- c("Datetime", "Temp", "Temp_exists",
#' "Temp_quality", "Rain", "Rain_exists", "Rain_qality")
#' col_types <- cols(col_datetime("%Y/%m/%d %H:%M:%S"),
#' col_double(), col_integer(), col_integer(),
#' col_double(), col_integer(), col_integer())
#' d <- f %>%
#'   map(function(x){
#'     read_csv(x, col_names=col_names, col_types=, skip=5)
#'     }) %>%
#'     bind_rows()
#' head(d)
#'
#' @export
read_jma <- function(from, to, phpsessid, wait=30){
  intervals <- split_interval(from, to)
  ret <- list()
  for (x in intervals){
    message(stringr::str_glue("POST: {int_start(x)} -- {int_end(x)}\n"))
    csv <- read_jma_monthly(int_start(x), int_end(x), phpsessid)
    ret <- c(ret, csv)
    wait(wait)
  }
  ret
}