R/meteoclimatic_helpers.R

In meteospain: Access to Spanish Meteorological Stations Services

#' Create the path elements for Meteoclimatic API
#'
#' Path vectors for Meteoclimatic API to use with httr::GET
#'
#' @param api_options Option list as generated by \link{\code{meteoclimatic_options}}
#'
#' @noRd
.create_meteoclimatic_path <- function(api_options) {

  meteoclimatic_path <- paste0("http://meteoclimatic.com/feed/xml/", api_options$stations)

  # not recognised resolution
  if (api_options$resolution != 'current_day') {
    cli::cli_abort(c(
      "{.arg {api_options$resolution}} is not a valid temporal resolution for Meteoclimatic. Please see meteoclimatic_options help for more information"
    ))
  }

  return(meteoclimatic_path)
}

#' Get info for the meteoclimatic stations
#'
#' Get info for the meteoclimatic stations
#'
#' @noRd

.get_info_meteoclimatic <- function(api_options) {
  # path
  path_resolution <- paste0("http://meteoclimatic.com/feed/rss/", api_options$stations)
  # station_info
  raw_station_info <- safe_api_access(type = 'xml', path_resolution)
  res <- dplyr::tibble(
    service = 'meteoclimatic',
    # station_id is special, we need obtain it from the link, so we need to remove all the link previous to the code
    station_id = substr(xml2::xml_text(xml2::xml_find_all(raw_station_info, '//item/link')), start = 37, stop = 100),
    # name, lat and long are elements in each node/item, so we extract them
    station_name = xml2::xml_text(xml2::xml_find_all(raw_station_info, '//item/title')),
    lat = xml2::xml_double(xml2::xml_find_all(raw_station_info, '//item/geo:Point/geo:lat')),
    long = xml2::xml_double(xml2::xml_find_all(raw_station_info, '//item/geo:Point/geo:long'))
  ) |>
    sf::st_as_sf(coords = c('long', 'lat'), crs = 4326)

  return(res)
}

#' Get data from Meteoclimatic
#'
#' Get data from Meteoclimatic service
#'
#' Only current day (hourly data) will be returned
#'
#' @param api_options Option list as generated by \link{\code{meteclimatic_options}}
#'
#' @noRd
.get_data_meteoclimatic <- function(api_options) {

  # api path
  path_resolution <- .create_meteoclimatic_path(api_options)

  # data
  data_xml_body <- safe_api_access(type = 'xml', path_resolution)
  # data is an xml file. Each station is a node in the xml, so we loop by nodes and build the tibble. Finally
  # we need the stations info, so we join it
  nodes <- xml2::xml_path(xml2::xml_find_all(data_xml_body, '//meteodata/stations/station'))
  # but before start iterating, if station code is wrong, no nodes are returned, so we need to check that
  if (length(nodes) < 1) {
    cli::cli_abort(c(
      'Stations code provided',
      api_options$stations,
      'not found in Meteoclimatic database.',
      i = "See https://www.meteoclimatic.net/index/wp/rss_es.html for more info"
    ))
  }

  # Now we can iterate and get the data
  stations_data <-
    nodes |>
    purrr::map(
      \(.x) {
        dplyr::tibble(
          service = 'meteoclimatic',
          timestamp = lubridate::parse_date_time(
            xml2::xml_text(xml2::xml_find_first(data_xml_body, paste0(.x, '/pubDate'))),
            orders = 'dbYHMSz'
          ),
          station_id = xml2::xml_text(
            xml2::xml_find_first(data_xml_body, paste0(.x, '/id'))
          ),
          max_temperature = xml2::xml_double(
            (xml2::xml_find_first(data_xml_body, paste0(.x, '/stationdata/temperature/max')))
          ),
          min_temperature = xml2::xml_double(
            (xml2::xml_find_first(data_xml_body, paste0(.x, '/stationdata/temperature/min')))
          ),
          max_relative_humidity = xml2::xml_double(
            (xml2::xml_find_first(data_xml_body, paste0(.x, '/stationdata/humidity/max')))
          ),
          min_relative_humidity = xml2::xml_double(
            (xml2::xml_find_first(data_xml_body, paste0(.x, '/stationdata/humidity/min')))
          ),
          precipitation = xml2::xml_double(
            (xml2::xml_find_first(data_xml_body, paste0(.x, '/stationdata/rain/total')))
          )
        )
      }
    ) |>
    purrr::list_rbind() |>
    dplyr::left_join(.get_info_meteoclimatic(api_options), by = c('service', 'station_id')) |>
    dplyr::select("timestamp", "station_id", "station_name", dplyr::everything()) |>
    dplyr::mutate(
      max_temperature = units::set_units(.data$max_temperature, "degree_C"),
      min_temperature = units::set_units(.data$min_temperature, "degree_C"),
      max_relative_humidity = units::set_units(.data$max_relative_humidity, "%"),
      min_relative_humidity = units::set_units(.data$min_relative_humidity, "%"),
      precipitation = units::set_units(.data$precipitation, "L/m^2")
    ) |>
    dplyr::arrange(.data$timestamp, .data$station_id) |>
    # reorder variables to be consistent among all services
    relocate_vars() |>
    sf::st_as_sf(crs = 4326)

  # Copyright message -------------------------------------------------------------------------------------
  cli::cli_inform(c(
    i = copyright_style("Meteoclimatic is a non-professional network of automatic meteorological stations."),
    copyright_style("No quality check is performed in this data, and errors in measures or coordinates of stations can be present."),
    legal_note_style("https://www.meteoclimatic.net/index")
  ))

  return(stations_data)
}