R/bbk.R

In bbk: Client for Central Bank APIs

#' Fetch Deutsche Bundesbank (BBk) data
#'
#' Retrieve time series data from the Bundesbank SDMX Web Service.
#'
#' @param flow (`character(1)`)\cr
#'   The flow to query, 5-8 characters. See [bbk_metadata()] for available dataflows.
#' @param key (`NULL` | `character()`)\cr
#'   The series keys to query.
#' @param start_period (`NULL` | `character(1)` | `integer(1)`)\cr
#'   The start date of the data. Supported formats:
#'   * YYYY for annual data (e.g., `2019`)
#'   * YYYY-S\[1-2\] for semi-annual data (e.g., `"2019-S1"`)
#'   * YYYY-Q\[1-4\] for quarterly data (e.g., `"2019-Q1"`)
#'   * YYYY-MM for monthly data (e.g., `"2019-01"`)
#'   * YYYY-W\[01-53\] for weekly data (e.g., `"2019-W01"`)
#'   * YYYY-MM-DD for daily and business data (e.g., `"2019-01-01"`)
#'
#'   If `NULL`, no start date restriction is applied (data retrieved from the earliest available
#'   date). Default `NULL`.
#' @param end_period (`NULL` | `character(1)` | `integer(1)`)\cr
#'   The end date of the data, in the same format as start_period. If `NULL`, no end date
#'   restriction is applied (data retrieved up to the most recent available date). Default `NULL`.
#' @param first_n (`NULL` | `numeric(1)`)\cr
#'   Number of observations to retrieve from the start of the series. If `NULL`, no restriction is
#'   applied. Default `NULL`.
#' @param last_n (`NULL` | `numeric(1)`)\cr
#'   Number of observations to retrieve from the end of the series. If `NULL`, no restriction is
#'   applied. Default `NULL`.
#' @param updated_after (`NULL` | `character(1)` | `Date(1)` | `POSIXct(1)`)\cr
#'   Retrieve only observations updated after the given timestamp (e.g.,
#'   `"2024-06-01T00:00:00"`). Useful for incremental retrieval. If `NULL`, no restriction is
#'   applied. Default `NULL`.
#' @returns A [data.table::data.table()] with the requested data.
#' @source <https://api.statistiken.bundesbank.de/>
#' @family data
#' @export
#' @examplesIf curl::has_internet()
#' \donttest{
#' # fetch all data for a given flow and key
#' data = bbk_data("BBSIS", "D.I.ZAR.ZI.EUR.S1311.B.A604.R10XX.R.A.A._Z._Z.A")
#' head(data)
#'
#' # fetch data for multiple keys
#' data = bbk_data("BBEX3", c("M.ISK.EUR", "USD.CA.AC.A01"))
#' head(data)
#'
#' # specified period (start date-end date) for daily data
#' data = bbk_data(
#'   "BBSIS", "D.I.ZAR.ZI.EUR.S1311.B.A604.R10XX.R.A.A._Z._Z.A",
#'   start_period = "2020-01-01",
#'   end_period = "2020-08-01"
#' )
#' head(data)
#'
#' # or only specify the start date
#' data = bbk_data(
#'   "BBSIS", "D.I.ZAR.ZI.EUR.S1311.B.A604.R10XX.R.A.A._Z._Z.A",
#'   start_period = "2024-04-01"
#' )
#' head(data)
#' }
bbk_data = function(
  flow,
  key = NULL,
  start_period = NULL,
  end_period = NULL,
  first_n = NULL,
  last_n = NULL,
  updated_after = NULL
) {
  assert_string(flow, min.chars = 5L, max.chars = 8L)
  assert_character(key, min.chars = 1L, null.ok = TRUE)
  assert_period(start_period)
  assert_period(end_period)
  first_n = assert_count(first_n, null.ok = TRUE, positive = TRUE, coerce = TRUE)
  last_n = assert_count(last_n, null.ok = TRUE, positive = TRUE, coerce = TRUE)
  updated_after = assert_timestampish(updated_after, null.ok = TRUE)

  resource = sdmx_data_resource(flow, key)
  xml = bbk_make_request(
    resource = resource,
    accept = "application/vnd.sdmx.genericdata+xml;version=2.1",
    startPeriod = start_period,
    endPeriod = end_period,
    firstNObservations = first_n,
    lastNObservations = last_n,
    preparedAfter = updated_after
  )
  parse_bbk_data(xml)
}

#' Fetch the Deutsche Bundesbank (BBk) series
#'
#' Retrieve a single series by its key via the Bundesbank SDMX Web Service.
#'
#' @inherit bbk_data source
#' @inheritParams bbk_data
#' @inherit bbk_data return
#' @family data
#' @seealso [bbk_data()] for an endpoint with more options.
#' @export
#' @examplesIf curl::has_internet()
#' \donttest{
#' bbk_series("BBEX3.M.DKK.EUR.BB.AC.A01")
#' bbk_series("BBAF3.Q.F41.S121.DE.S1.W0.LE.N._X.B")
#' bbk_series("BBBK11.D.TTA000")
#' }
bbk_series = function(key) {
  assert_string(key, min.chars = 1L)
  body = bbk_build_request("data/tsIdList", accept = "application/vnd.bbk.data+csv-zip") |>
    req_body_json(key, auto_unbox = FALSE) |>
    req_bbk_retry() |>
    req_bbk_cache() |>
    req_perform() |>
    resp_body_raw()
  parse_bbk_series(body, key)
}

#' Fetch Deutsche Bundesbank (BBk) metadata
#'
#' Retrieve metadata from the Bundesbank time series database via the SDMX Web Service.
#'
#' @param type (`character(1)`)\cr
#'   The type of metadata to query.
#'   One of: `"datastructure"`, `"dataflow"`, `"codelist"`, or `"concept"`.
#' @param id (`NULL` | `character(1)`)\cr
#'   The id to query. Default `NULL`.
#' @param lang (`character(1)`)\cr
#'   Language to query, either `"en"` or `"de"`. Default `"en"`.
#' @returns A [data.table::data.table()] with the requested metadata.
#' The columns are:
#'   \item{id}{The id of the metadata}
#'   \item{name}{The name of the metadata}
#' @source <https://api.statistiken.bundesbank.de/>
#' @family metadata
#' @export
#' @examplesIf curl::has_internet()
#' \donttest{
#' bbk_metadata("datastructure")
#' bbk_metadata("dataflow", "BBSIS")
#' bbk_metadata("codelist", "CL_BBK_ACIP_ASSET_LIABILITY")
#' bbk_metadata("concept", "CS_BBK_BSPL")
#' }
bbk_metadata = function(type, id = NULL, lang = "en") {
  assert_choice(type, c("datastructure", "dataflow", "codelist", "concept"))
  args = switch(
    type,
    datastructure = list("datastructure/BBK", "//structure:DataStructure"),
    dataflow = list("dataflow/BBK", "//structure:Dataflow"),
    codelist = list("codelist/BBK", "//structure:Codelist"),
    concept = list("conceptscheme/BBK", "//structure:ConceptScheme")
  )
  dt = do.call(fetch_bbk_metadata, c(args, list(id, lang)))
  name = NULL
  dt[!nzchar(name), name := NA_character_][]
}

#' Fetch Deutsche Bundesbank (BBk) dimensions
#'
#' Retrieve the dimension structure for a given dataflow from the Bundesbank SDMX Web Service.
#'
#' @param id (`character(1)`)\cr
#'   The id of the data structure definition to query (e.g., `"BBK_BBSIS"`).
#' @returns A [data.table::data.table()] with columns:
#'   \item{id}{The dimension id (e.g., `"BBK_STD_FREQ"`, `"BBK_STD_AREA"`)}
#'   \item{position}{The position of the dimension in the series key}
#'   \item{codelist}{The id of the associated codelist}
#' @source <https://api.statistiken.bundesbank.de/>
#' @family metadata
#' @export
#' @examplesIf curl::has_internet()
#' \donttest{
#' bbk_dimension("BBK_ERX")
#' }
bbk_dimension = function(id) {
  assert_string(id, min.chars = 1L)
  resource = paste("metadata", "datastructure", "BBK", toupper(id), sep = "/")
  xml = bbk_make_request(resource)
  sdmx_dimension(xml, ns_prefix = "structure")
}

parse_bbk_series = function(body, key) {
  td = tempfile()
  dir.create(td)
  on.exit(unlink(td, recursive = TRUE), add = TRUE)
  tf = file.path(td, "tempfile.zip")
  writeBin(body, tf)
  utils::unzip(tf, exdir = td)

  files = list.files(td, full.names = TRUE)
  path = grepv("\\.csv$", files)[[1L]]

  lines = readLines(path, encoding = "UTF-8")
  data_start = grep("^\"?\\d{4}[-,]", lines)[1L]
  if (is.na(data_start)) {
    data_start = length(lines) + 1L
    dt = data.table(date = character(), value = character())
  } else {
    dt = fread(file = path, header = FALSE, skip = data_start - 1L, select = 1:2)
    setnames(dt, c("date", "value"))
  }
  value = NULL
  dt[value %in% c(".", "-"), value := NA_character_]
  dt = na.omit(dt)

  metadata = lines[seq_len(data_start - 1L)]
  title = sub("^[\",]+", "", metadata[[2L]])
  title = sub("[\",]+$", "", title)
  freq = extract_metadata(metadata, "^Time format code")
  unit = extract_metadata(metadata, "^Unit \\(in english\\),")
  if (is.na(unit)) {
    unit = extract_metadata(metadata, "^unit,")
  }
  unit_mult = extract_metadata(metadata, "^unit multiplier,")
  category = extract_metadata(metadata, "^category,")
  last_update = extract_metadata(metadata, "^last update,")
  comment = extract_metadata(metadata, "^Comment \\(in english\\),")
  src = extract_metadata(metadata, "^Source \\(in english\\),")

  freq = sdmx_freq(freq)
  dt[, let(
    date = parse_date(date, freq),
    value = as.numeric(value),
    key = key,
    title = title,
    freq = freq,
    category = category,
    unit = unit,
    unit_mult = unit_mult,
    last_update = last_update,
    comment = comment,
    source = src
  )]
  setcolorder(dt, col_order, skip_absent = TRUE)
  dt[]
}

parse_bbk_data = function(xml) {
  series = xml2::xml_find_all(xml, ".//generic:Series")
  dt = map(series, function(x) {
    series_key = x |>
      xml2::xml_find_first(".//generic:SeriesKey") |>
      xml2::xml_children()
    nms = series_key |>
      xml2::xml_attr("id") |>
      tolower()
    series_key = series_key |>
      xml2::xml_attr("value") |>
      setNames(nms) |>
      as.list()

    attrs = x |>
      xml2::xml_find_first("./generic:Attributes") |>
      xml2::xml_children()
    nms = attrs |>
      xml2::xml_attr("id") |>
      tolower()
    attrs = attrs |>
      xml2::xml_attr("value") |>
      setNames(nms) |>
      as.list()

    data = c(series_key, attrs)
    nms = names(data)
    nms = sub("^bbk_(seis_)?", "", nms)
    nms = sub("^std_", "", nms)
    has_eng = paste0(nms, "_eng") %in% nms
    for (i in which(has_eng)) {
      j = match(paste0(nms[[i]], "_eng"), nms)
      if (is.na(data[[j]])) {
        data[[j]] = data[[i]]
      }
    }
    data = data[!has_eng]
    nms = sub("_eng$", "", nms[!has_eng])
    # fmt: skip
    nms = fcase(
      nms == "id", "key",
      nms == "web_category", "category",
      default = nms
    )
    names(data) = nms

    data$freq = sdmx_freq(data$time_format)

    entries = xml2::xml_find_all(x, ".//generic:Obs[generic:ObsValue]")
    data$date = entries |>
      xml2::xml_find_all(".//generic:ObsDimension") |>
      xml2::xml_attr("value") |>
      parse_date(data$freq)

    data$value = entries |>
      xml2::xml_find_all(".//generic:ObsValue") |>
      xml2::xml_attr("value") |>
      as.numeric()

    as.data.table(data)
  }) |>
    rbindlist(fill = TRUE)
  decimals = NULL
  dt[, decimals := as.integer(decimals)]
  setcolorder(dt, col_order, skip_absent = TRUE)
  dt[]
}

fetch_bbk_metadata = function(resource, xpath, id = NULL, lang = "en") {
  assert_choice(lang, c("en", "de"))
  assert_string(id, min.chars = 1L, null.ok = TRUE)

  resource = paste("metadata", resource, sep = "/")
  if (!is.null(id)) {
    resource = paste(resource, toupper(id), sep = "/")
  }
  xml = bbk_make_request(resource)
  entries = xml2::xml_find_all(xml, xpath)
  sdmx_metadata(entries, lang, ns_prefix = "common")
}

bbk_error_body = function(resp) {
  content_type = resp_content_type(resp)
  if (identical(content_type, "application/json")) {
    msg = resp_body_json(resp)$title
    docs = "See docs at <https://api.statistiken.bundesbank.de/doc/index.html>" # nolint
    c(msg, docs)
  }
}

bbk_build_request = function(resource, accept = NULL) {
  request("https://api.statistiken.bundesbank.de/rest") |>
    req_user_agent(bbk_user_agent()) |>
    req_headers(`Accept-Language` = "en", accept = accept) |>
    req_url_path_append(resource) |>
    req_error(body = bbk_error_body)
}

bbk_make_request = function(resource, ..., accept = NULL) {
  sdmx_request(
    "https://api.statistiken.bundesbank.de/rest",
    resource,
    bbk_error_body,
    ...,
    accept = accept
  )
}