test-bdp.R
In bbk: Client for Central Bank APIs

test_that("bdp_data input validation works", {
  expect_error(bdp_data("a", "b"))
  expect_error(bdp_data(1L, 123L))
  expect_error(bdp_data(1L, "b", series_ids = "abc"))
  expect_error(bdp_data(1L, "b", start_date = ""))
  expect_error(bdp_data(1L, "b", end_date = 1L))
  expect_error(bdp_data(1L, "b", lang = "FR"))
  expect_error(bdp_data(1L, "b", updated_after = 1L))
  expect_error(bdp_data(1L, "b", updated_after = TRUE))
  expect_error(bdp_data(1L, "b", updated_after = NA))
})

test_that("bdp_data passes updated_after as obs_published_since", {
  captured = NULL
  httr2::local_mocked_responses(function(req) {
    captured <<- req
    httr2::response(200L, headers = "content-type: application/json", body = charToRaw("{}"))
  })
  local_mocked_bindings(parse_bdp_data = function(json) data.table())
  bdp_data(54L, "ce3e", updated_after = as.Date("2024-06-01"))
  expect_match(captured$url, "obs_published_since=2024-06-01T00%3A00%3A00Z")
})

test_that("bdp_data follows next_page and keeps every series", {
  page = function(ids, values, next_page = NULL) {
    extension = list(
      series = lapply(ids, \(i) {
        list(
          id = i,
          label = paste0("s", i),
          dimension_category = list(list(dimension_id = 7L, category_id = i))
        )
      })
    )
    if (!is.null(next_page)) {
      extension$next_page = next_page
    }
    body = list(
      id = list("7", "reference_date"),
      size = list(length(ids), 2L),
      role = list(time = list("reference_date")),
      dimension = list(
        `7` = list(category = list(index = as.list(as.character(ids)))),
        reference_date = list(category = list(index = list("2020-01-01", "2020-02-01")))
      ),
      value = as.list(values),
      extension = extension
    )
    httr2::response(
      200L,
      headers = "content-type: application/json",
      body = charToRaw(jsonlite::toJSON(body, auto_unbox = TRUE, null = "null"))
    )
  }

  n = 0L
  httr2::local_mocked_responses(function(req) {
    n <<- n + 1L
    if (n == 1L) {
      page(c(1L, 2L), c(10, 11, 20, 21), next_page = "https://bpstat.bportugal.pt/data/v1/x?page=2")
    } else {
      page(c(3L, 4L), c(30, 31, 40, 41))
    }
  })

  actual = bdp_data(54L, "abc")
  expect_identical(n, 2L)
  expect_identical(sort(unique(actual$key)), 1:4)
  expect_identical(actual$value, c(10, 11, 20, 21, 30, 31, 40, 41))
})

test_that("bdp_series input validation works", {
  expect_error(bdp_series("abc"))
  expect_error(bdp_series(NULL))
  expect_error(bdp_series(1L, lang = "FR"))
})

test_that("bdp_dataset input validation works", {
  expect_error(bdp_dataset("a"))
  expect_error(bdp_dataset(1L, lang = "FR"))
})

test_that("bdp_dimension input validation works", {
  expect_error(bdp_dimension("a"))
  expect_error(bdp_dimension(1L, dimension_id = "a"))
  expect_error(bdp_dimension(1L, lang = "FR"))
})

test_that("bdp_domain input validation works", {
  expect_error(bdp_domain("a"))
  expect_error(bdp_domain(lang = "FR"))
})

test_that("parse_bdp_data works", {
  json = readRDS(test_path("fixtures", "bdp-data.rds"))
  actual = parse_bdp_data(json)
  expect_data_table(actual, min.rows = 1L)
  expect_date(actual$date)
  expect_numeric(actual$value)
  expect_names(names(actual), must.include = c("date", "value", "freq"))
})

test_that("parse_bdp_data keeps missing observations as NA instead of collapsing", {
  json = list(
    id = list("reference_date"),
    size = list(3L),
    role = list(time = list("reference_date")),
    dimension = list(
      reference_date = list(category = list(index = list("2020-01-01", "2020-02-01", "2020-03-01")))
    ),
    value = list(1.5, NULL, 2.0),
    status = list("F", "M", "F"),
    extension = list(series = list(list(id = 1L, label = "s1")))
  )
  actual = parse_bdp_data(json)
  expect_identical(actual$value, c(1.5, NA, 2.0))
  expect_identical(actual$date, as.Date(c("2020-01-01", "2020-02-01", "2020-03-01")))
})

test_that("parse_bdp_data maps sparse values onto the right series and date", {
  json = readRDS(test_path("fixtures", "bdp-data-multi.rds"))
  # the response is a sparse JSON-stat object whose `extension$series` order
  # differs from the order of the value array
  expect_false(is.null(names(json$value)))
  actual = parse_bdp_data(json)

  expect_data_table(actual, nrows = 3L * 346L)
  expect_date(actual$date)
  expect_identical(sort(unique(actual$key)), c(12558817L, 12558819L, 12558825L))
  expect_identical(uniqueN(actual, by = c("key", "date")), nrow(actual))

  # ground truth taken from one single-series request per series
  first = actual[actual[, .I[1L], by = key]$V1]
  expect_identical(first$date, rep(as.Date("1997-09-30"), 3L))
  expect_identical(first$key, c(12558817L, 12558819L, 12558825L))
  expect_identical(first$value, c(-68, 62011, 778))
})

test_that("bdp_cell_values matches sparse keys at or above 1e5 without scientific notation", {
  # cell offsets are doubles; as.character(1e5) would be "1e+05" and miss the key
  x = list(`100000` = 1.5, `3` = 2.5)
  expect_identical(bdp_cell_values(x, c(100000, 3), "numeric"), c(1.5, 2.5))
})

test_that("parse_bdp_data handles a dense value array", {
  json = list(
    id = list("7", "reference_date"),
    size = list(2L, 3L),
    role = list(time = list("reference_date")),
    dimension = list(
      `7` = list(category = list(index = list("20", "10"))),
      reference_date = list(category = list(index = list("2020-01-01", "2020-02-01", "2020-03-01")))
    ),
    value = list(1, 2, 3, 4, 5, 6),
    extension = list(
      series = list(
        list(
          id = 1L,
          label = "s1",
          dimension_category = list(list(dimension_id = 7L, category_id = 10L))
        ),
        list(
          id = 2L,
          label = "s2",
          dimension_category = list(list(dimension_id = 7L, category_id = 20L))
        )
      )
    )
  )
  actual = parse_bdp_data(json)
  # category "20" comes first in the index, so the first block belongs to series 2
  expect_identical(actual$key, c(rep(1L, 3L), rep(2L, 3L)))
  expect_identical(actual$value, c(4, 5, 6, 1, 2, 3))
})

test_that("parse_bdp_data returns a typed empty table when the window has no observations", {
  empty = parse_bdp_data(list(
    id = list("reference_date"),
    size = list(0L),
    role = list(time = list("reference_date")),
    dimension = list(reference_date = list(category = list(index = list()))),
    value = list(),
    extension = list(series = list())
  ))
  expect_data_table(empty, nrows = 0L)
  expect_date(empty$date)
  expect_names(names(empty), must.include = c("date", "key", "value", "freq"))
})

test_that("bdp_freq detects the observation frequency", {
  expect_identical(bdp_freq(c("2024-01-05", "2024-01-08", "2024-01-09")), "daily")
  expect_identical(bdp_freq(c("2024-01-01", "2024-01-08", "2024-01-15")), "weekly")
  expect_identical(bdp_freq(c("2024-01-01", "2024-01-16", "2024-02-01")), "biweekly")
  expect_identical(bdp_freq(c("2024-01-01", "2024-02-01", "2024-03-01")), "monthly")
  expect_identical(bdp_freq(c("2024-01-01", "2024-04-01", "2024-07-01")), "quarterly")
  expect_identical(bdp_freq(c("2024-01-01", "2024-07-01", "2025-01-01")), "semi-annual")
  expect_identical(bdp_freq(c("2023-12-31", "2024-12-31")), "annual")
  expect_identical(bdp_freq("2024-01-01"), NA_character_)
  expect_identical(bdp_freq(character()), NA_character_)
})

test_that("parse_bdp_series works", {
  json = readRDS(test_path("fixtures", "bdp-series.rds"))
  actual = parse_bdp_series(json)
  expect_data_table(actual, nrows = 1L)
  expect_names(
    names(actual),
    must.include = c("id", "label", "dataset_id", "domain_id")
  )
  expect_identical(actual$id, 12518356L)
})

test_that("parse_bdp_dataset works", {
  json = readRDS(test_path("fixtures", "bdp-dataset.rds"))
  actual = parse_bdp_dataset(json)
  expect_data_table(actual, min.rows = 1L)
  expect_names(
    names(actual),
    must.include = c("id", "label", "num_series", "obs_updated_at")
  )
})

test_that("parse_bdp_dimension works", {
  items = readRDS(test_path("fixtures", "bdp-dimension.rds"))
  actual = parse_bdp_dimension(items)
  expect_data_table(actual, min.rows = 1L)
  expect_names(names(actual), must.include = c("id", "label", "description"))
})

test_that("parse_bdp_category works", {
  json = readRDS(test_path("fixtures", "bdp-category.rds"))
  actual = parse_bdp_category(json)
  expect_data_table(actual, min.rows = 1L)
  expect_names(names(actual), must.include = c("id", "label"))
})

test_that("parse_bdp_domain works", {
  json = readRDS(test_path("fixtures", "bdp-domains.rds"))
  actual = parse_bdp_domain(json)
  expect_data_table(actual, min.rows = 1L)
  expect_names(
    names(actual),
    must.include = c("id", "label", "has_series", "num_series")
  )
})