R/pip.R

In worldbank: Client for World Banks's 'Indicators' and 'Poverty and Inequality Platform (PIP)' APIs

#' Return main poverty and inequality statistics
#'
#' @param country (`NULL` | `character()`)\cr
#'   Countries for which statistics are to be computed, specified as ISO3 codes. Default `NULL`.
#' @param year (`NULL` | `character()` | `numeric()`)\cr
#'   Years for which statistics are to be computed, specified as YYYY. Default `NULL`.
#' @param povline (`numeric(1)`)\cr
#'   Poverty line to be used to compute poverty mesures. Poverty lines are only accepted up to 3
#'   decimals. Default `2.15`.
#' @param popshare (`NULL` | `numeric(1)`)\cr
#'   Proportion of the population living below the poverty line. Will be ignored if povline is
#'   specified. Default `NULL`.
#' @param fill_gaps (`logical(1)`)\cr
#'   Whether to fill gaps in the data. Default `FALSE`.
#' @param welfare_type (`character(1)`)\cr
#'   Type of welfare measure to be used. Default `"all"`.
#' @param reporting_level (`character(1)`)\cr
#'   level of reporting for the statistics. Default `"all"`.
#' @param additional_ind (`logical(1)`)\cr
#'   Whether to include additional indicators. Default `FALSE`.
#' @param release_version (`NULL` | `character(1)`)\cr
#'   Version of the data release in YYYYMMDD format. Default `NULL`.
#' @param ppp_version (`NULL` | `character(1)` | `numeric(1)`)\cr
#'   Version of the data. Default `NULL`.
#' @param version (`NULL` | `character(1)`)\cr
#'   Version of the data. Default `NULL`.
#' @returns A `data.frame()` with the requested statistics.
#' @source <https://pip.worldbank.org/api>
#' @family poverty and inequality statistics
#' @export
#' @examplesIf httr2::is_online()
#' \donttest{
#' data <- pip_data(c("ZAF", "ZMB"))
#' head(data)
#' }
pip_data <- function(
  country = NULL,
  year = NULL,
  povline = 2.15,
  popshare = NULL,
  fill_gaps = FALSE,
  welfare_type = c("all", "consumption", "income"),
  reporting_level = c("all", "national", "rural", "urban"),
  additional_ind = FALSE,
  release_version = NULL,
  ppp_version = NULL,
  version = NULL
) {
  welfare_type <- match.arg(welfare_type)
  reporting_level <- match.arg(reporting_level)
  if (!is.null(year)) {
    year <- as.character(year)
  }
  if (!is.null(ppp_version)) {
    ppp_version <- as.character(ppp_version)
  }
  stopifnot(
    is.null(country) || is_character(country) && all(nchar(country) == 3L),
    is.null(year) || is_character(year) && all(grepl("[0-9]{4}", year)),
    is_flag(fill_gaps),
    is_string(release_version, pattern = "[0-9]{8}", null_ok = TRUE),
    is_flag(additional_ind),
    is_string(ppp_version, pattern = "[0-9]{4}", null_ok = TRUE),
    is_string(version, null_ok = TRUE)
  )
  res <- pip(
    resource = "pip",
    country = country,
    year = year,
    povline = povline,
    popshare = popshare,
    fill_gaps = fill_gaps,
    welfare_type = welfare_type,
    reporting_level = reporting_level,
    additional_ind = additional_ind,
    release_version = release_version,
    ppp_version = ppp_version,
    version = version,
    format = "csv",
    .multi = "comma"
  )
  res
}

#' Return aggregation of PIP statistics
#'
#' @inheritParams pip_data
#' @param group_by (`character(1)`)\cr
#'   Aggregate results by pre-defined sub-groups. Default `"wb"`.
#' @returns A `data.frame()` with the requested statistics.
#' @inherit pip_data source
#' @family poverty and inequality statistics
#' @export
#' @examplesIf httr2::is_online()
#' \donttest{
#' grp <- pip_group(c("AFE", "LAC"))
#' head(grp)
#' }
pip_group <- function(
  country = NULL,
  year = NULL,
  povline = 2.15,
  popshare = NULL,
  group_by = c("wb", "none"),
  fill_gaps = FALSE,
  welfare_type = c("all", "consumption", "income"),
  reporting_level = c("all", "national", "rural", "urban"),
  additional_ind = FALSE,
  release_version = NULL,
  ppp_version = NULL,
  version = NULL
) {
  group_by <- match.arg(group_by)
  welfare_type <- match.arg(welfare_type)
  reporting_level <- match.arg(reporting_level)
  if (!is.null(year)) {
    year <- as.character(year)
  }
  if (!is.null(ppp_version)) {
    ppp_version <- as.character(ppp_version)
  }
  stopifnot(
    is.null(country) || is_character(country) && all(nchar(country) == 3L),
    is.null(year) || is_character(year) && all(grepl("[0-9]{4}", year)),
    is_flag(fill_gaps),
    is_string(release_version, pattern = "[0-9]{8}", null_ok = TRUE),
    is_flag(additional_ind),
    is_string(ppp_version, pattern = "[0-9]{4}", null_ok = TRUE),
    is_string(version, null_ok = TRUE)
  )
  res <- pip(
    resource = "pip-grp",
    country = country,
    year = year,
    povline = povline,
    popshare = popshare,
    fill_gaps = fill_gaps,
    group_by = group_by,
    welfare_type = welfare_type,
    reporting_level = reporting_level,
    additional_ind = additional_ind,
    release_version = release_version,
    ppp_version = ppp_version,
    version = version,
    format = "csv",
    .multi = "comma"
  )
  res
}

#' Return the available data versions
#'
#' @returns A `data.frame()` with the available versions.
#' @inherit pip_data source
#' @family poverty and inequality statistics
#' @export
#' @examplesIf httr2::is_online()
#' \donttest{
#' vers <- pip_versions()
#' head(vers)
#' }
pip_versions <- function() {
  res <- pip("versions", format = "csv")
  res
}

#' Return citation for a given version
#'
#' @inheritParams pip_data
#' @returns A `data.frame()` with the citation.
#' @inherit pip_data source
#' @family poverty and inequality statistics
#' @export
#' @examplesIf httr2::is_online()
#' \donttest{
#' pip_citation()
#' }
pip_citation <- function(
  release_version = NULL,
  ppp_version = NULL,
  version = NULL
) {
  if (!is.null(ppp_version)) {
    ppp_version <- as.character(ppp_version)
  }
  stopifnot(
    is_string(release_version, pattern = "[0-9]{8}", null_ok = TRUE),
    is_string(ppp_version, pattern = "[0-9]{4}", null_ok = TRUE),
    is_string(version, null_ok = TRUE)
  )
  res <- pip(
    resource = "citation",
    release_version = release_version,
    ppp_version = ppp_version,
    version = version,
    format = "json"
  )
  res <- data.frame(
    citation = res$citation[[1L]],
    version = res$version[[1L]],
    date_accessed = res$date_accessed[[1L]],
    check.names = FALSE
  )
  res
}

#' Return auxiliary data tables
#'
#' @param table (`NULL` | `character(1)`)\cr
#'   Table to be returned. Default `NULL`.
#' @inheritParams pip_data
#' @returns A `character()` with the available tables or a `data.frame()` containing the table data.
#' @inherit pip_data source
#' @family poverty and inequality statistics
#' @export
#' @examplesIf httr2::is_online()
#' \donttest{
#' # get a list of available tables
#' pip_aux()
#'
#' # get countries
#' aux <- pip_aux("countries")
#' head(aux)
#'
#' # get GDP
#' aux <- pip_aux("gdp")
#' head(aux)
#'
#' # get CPI
#' aux <- pip_aux("cpi")
#' head(aux)
#' }
pip_aux <- function(
  table = NULL,
  release_version = NULL,
  ppp_version = NULL,
  version = NULL
) {
  if (!is.null(ppp_version)) {
    ppp_version <- as.character(ppp_version)
  }
  stopifnot(
    is_string(table, null_ok = TRUE),
    is_string(release_version, pattern = "[0-9]{8}", null_ok = TRUE),
    is_string(ppp_version, pattern = "[0-9]{4}", null_ok = TRUE),
    is_string(version, null_ok = TRUE)
  )
  if (is.null(table)) {
    res <- pip(
      resource = "aux",
      table = table,
      release_version = release_version,
      ppp_version = ppp_version,
      version = version,
      format = "json"
    )
    map_chr(res, "tables")
  } else {
    res <- pip(
      resource = "aux",
      table = table,
      release_version = release_version,
      ppp_version = ppp_version,
      version = version,
      format = "csv"
    )
    clean_strings(res)
  }
}

#' Return valid query parameters
#'
#' @inheritParams pip_data
#' @param endpoint (`character(1)`)\cr
#'   Endpoint for which valid parameters are to be returned. Default `"all"`.
#' @returns A `data.frame()` with the valid parameters.
#' @inherit pip_data source
#' @family poverty and inequality statistics
#' @export
#' @examplesIf httr2::is_online()
#' \donttest{
#' params <- pip_valid_params()
#' head(params)
#' }
pip_valid_params <- function(
  endpoint = c("all", "aux", "pip", "pip-grp", "pip-info", "valid-params"), # nolint
  release_version = NULL,
  ppp_version = NULL,
  version = NULL
) {
  if (!is.null(ppp_version)) {
    ppp_version <- as.character(ppp_version)
  }
  stopifnot(
    is_string(release_version, pattern = "[0-9]{8}", null_ok = TRUE),
    is_string(ppp_version, pattern = "[0-9]{4}", null_ok = TRUE),
    is_string(version, null_ok = TRUE)
  )
  endpoint <- match.arg(endpoint)
  res <- pip(
    resource = "valid-params",
    endpoint = endpoint,
    release_version = release_version,
    ppp_version = ppp_version,
    version = version,
    format = "csv"
  )
  clean_strings(res)
}

#' Return information about the API
#'
#' @returns A `data.frame()` with the API information.
#' @inherit pip_data source
#' @family poverty and inequality statistics
#' @export
#' @examplesIf httr2::is_online()
#' \donttest{
#' pip_info()
#' }
pip_info <- function() {
  pip("pip-info", format = "json")
}

#' Determine if the API is running and listening as expected
#'
#' @returns A `character(1)` with the health check message.
#' @inherit pip_data source
#' @family poverty and inequality statistics
#' @export
#' @examplesIf httr2::is_online()
#' \donttest{
#' pip_health_check()
#' }
pip_health_check <- function() {
  msg <- pip("health-check", format = "json")
  msg[[1L]]
}

pip_error_body <- function(resp) {
  content_type <- resp_content_type(resp)
  if (identical(content_type, "application/json")) {
    json <- resp_body_json(resp)
    msg <- json$error[[1L]]
    details <- json$details$msg[[1L]]
    details <- gsub("\\s+", " ", details)
    c(msg, details)
  }
}

pip <- function(resource, ..., format = c("json", "csv", "xml", "rds")) {
  format <- match.arg(format)
  resp <- request("https://api.worldbank.org/pip/v1") |>
    req_user_agent("worldbank (https://m-muecke.github.io/worldbank)") |>
    req_url_path_append(resource) |>
    req_error(body = pip_error_body) |>
    req_url_query(format = format, ...) |>
    req_wb_cache() |>
    req_perform()

  body <- switch(
    format,
    json = resp_body_json(resp),
    csv = {
      body <- resp_body_string(resp, "UTF-8")
      utils::read.csv(textConnection(body, encoding = "UTF-8"))
    },
    xml = resp_body_xml(resp),
    rds = resp_body_raw(resp)
  )
  body
}