R/bde-catalogs.R

In tidyBdE: Retrieve Time Series Data from 'Banco de España'

#' Load, update and search BdE catalog metadata
#'
#' @description
#' These functions manage BdE time series catalog metadata from the bulk CSV
#' files published by Banco de España.
#'
#' `bde_catalog_load()` loads time series catalog metadata into a tibble,
#' `bde_catalog_update()` refreshes the cached catalog files and
#' `bde_catalog_search()` searches catalog metadata for keywords.
#'
#' @param catalog A catalog identifier or `"ALL"` to load or update every
#'   catalog. See **Details**.
#' @param parse_dates Logical. If `TRUE`, date columns are parsed with
#'   [bde_parse_dates()].
#' @param update_cache Logical. If `TRUE`, the requested file is refreshed in
#'   `cache_dir`.
#' @param cache_dir Path to a cache directory. The directory can also be set
#'   with `options(bde_cache_dir = "path/to/dir")`.
#' @param verbose Logical. If `TRUE`, display informative messages.
#' @param pattern Regular expression to search for. See **Details** and
#'   **Examples**.
#' @param ... Additional arguments passed by `bde_catalog_search()` to
#'   [bde_catalog_load()].
#'
#' @details
#' Accepted values for `catalog` are:
#'
#' ```{r, echo=FALSE}
#'
#' t <- tibble::tribble(
#' ~CODE, ~PUBLICATION, ~UPDATEFREQUENCY, ~FREQUENCY,
#' '`"BE"`', "Statistical Bulletin", "Daily", "Monthly",
#' '`"SI"`', "Summary Indicators", "Daily", "Daily",
#' '`"TC"`', "Exchange Rates", "Daily", "Daily",
#' '`"TI"`', "Interest Rates", "Daily", "Daily",
#' '`"PB"`', "Bank Lending Survey", "Quarterly", "Quarterly",
#' )
#'
#' names(t) <- paste0("**",
#'   c("CODE", "PUBLICATION", "UPDATE FREQUENCY", "FREQUENCY"),
#'   "**")
#'
#' knitr::kable(t)
#' ```
#' Use `"ALL"` as a shorthand for loading or updating all catalogs at once.
#'
#' If the requested catalog is not cached, `bde_catalog_load()` calls
#' [bde_catalog_update()].
#'
#' **Note:** BdE catalog metadata is currently available in Spanish only.
#' Therefore, search terms passed to `bde_catalog_search()` must be in Spanish
#' to retrieve results.
#'
#' `bde_catalog_search()` uses [base::grep()] to find matches in the catalog
#' metadata. You can pass [regular expressions][base::regex] to broaden the
#' search.
#'
#' @return
#' `bde_catalog_load()` returns a [tibble][tibble::tbl_df] with the requested
#' time series catalog metadata. See
#' `vignette("csv_manual", package = "tidyBdE")` for details.
#'
#' `bde_catalog_update()` returns an invisible list of download results.
#'
#' `bde_catalog_search()` returns a [tibble][tibble::tbl_df] with matching
#' catalog rows.
#'
#' @source
#' ```{r, echo=FALSE, results='asis'}
#' cat(paste0(
#'   "[Banco de España time series bulk data download]",
#'   "(https://www.bde.es/webbe/en/estadisticas/recursos/",
#'   "descargas-completas.html)."
#' ))
#' ```
#'
#' @seealso
#' - [bde_series_load()] and [bde_series_full_load()] load bulk CSV series.
#' - [bde_series_api_load()] and [bde_series_api_latest()] retrieve series
#'   through the Statistics web service (API).
#'
#' @rdname bde_catalogs
#' @name bde_catalogs
#'
#' @concept catalog
#'
#' @encoding UTF-8
#' @export
#'
#' @examplesIf bde_check_access()
#' \donttest{
#' bde_catalog_load("TI", verbose = TRUE)
#'
#' # Simple search. Search terms must be in Spanish.
#' # PIB [es] == GDP [en].
#' bde_catalog_search("PIB")
#'
#' # Search with a single complex condition.
#' bde_catalog_search("Francia(.*)PIB")
#'
#' # Search with multiple complex conditions.
#' bde_catalog_search("Francia(.*)PIB|Italia(.*)PIB|Alemania(.*)PIB")
#'
#' bde_catalog_update("TI", verbose = TRUE)
#' }
bde_catalog_load <- function(
  catalog = c("ALL", "BE", "SI", "TC", "TI", "PB"),
  parse_dates = TRUE,
  cache_dir = NULL,
  update_cache = FALSE,
  verbose = FALSE
) {
  catalog <- match_arg_pretty(catalog)
  # Validate input arguments.
  valid_catalogs <- c("BE", "SI", "TC", "TI", "PB", "ALL")
  bde_hlp_abort_if_not(
    "{.arg cache_dir} must be a {.cls character} vector or {.val NULL}." = any(
      is.null(cache_dir),
      is.character(cache_dir)
    ),
    "{.arg verbose} must be a {.cls logical} vector." = is.logical(verbose),
    "{.arg parse_dates} must be a {.cls logical} vector." = is.logical(
      parse_dates
    ),
    "{.arg update_cache} must be a {.cls logical} vector." = is.logical(
      update_cache
    )
  )

  catalog_to_load <- catalog
  if (catalog == "ALL") {
    catalog_to_load <- setdiff(valid_catalogs, "ALL")
  }

  # Honor the configured cache location before reading or downloading files.
  cache_dir <- bde_hlp_cachedir(cache_dir = cache_dir, verbose = verbose)

  final_catalog <- lapply(catalog_to_load, function(x) {
    catalog_file <- paste0("catalogo_", tolower(x), ".csv")
    catalog_file <- file.path(cache_dir, catalog_file)
    has_cache <- file.exists(catalog_file)

    if (all(has_cache, isFALSE(update_cache))) {
      if (verbose) cli::cli_alert_success("Using cached catalog {.str {x}}.")
    } else {
      # Download the catalog when it is missing or must be refreshed.
      if (verbose) {
        cli::cli_alert_info("Downloading catalog {.str {x}}.")
      }

      result <- bde_catalog_update(
        catalog = x,
        cache_dir = cache_dir,
        verbose = verbose
      )

      # Handle download errors.
      if (any(is.data.frame(result), isFALSE(result))) {
        cli::cli_alert_warning(
          "Catalog {.str {x}} is not available for download."
        )
        return(NULL)
      }
    }

    # Reject empty files before encoding detection.
    r <- readLines(catalog_file, warn = FALSE, n = 1000)
    if (length(r) == 0) {
      cli::cli_alert_warning("File {.file {catalog_file}} is empty.")
      unlink(catalog_file)
      return(invisible())
    }

    enc <- readr::guess_encoding(catalog_file)[[1]][[1]]

    catalog_load <- suppressWarnings(read.csv2(
      catalog_file,
      sep = ",",
      stringsAsFactors = FALSE,
      na.strings = c("", "-", "_"),
      header = FALSE,
      fileEncoding = enc
    ))

    # Avoid UTF-8 check failures from upstream Spanish column names.
    names_catalog <- c(
      "Nombre_de_la_serie",
      "Numero_secuencial",
      "Alias_de_la_serie",
      "Nombre_del_archivo_con_los_valores_de_la_serie",
      "Descripcion_de_la_serie",
      "Tipo_de_variable",
      "Codigo_de_unidades",
      "Exponente",
      "Numero_de_decimales",
      "Descripcion_de_unidades_y_exponente",
      "Frecuencia_de_la_serie",
      "Fecha_de_la_primera_observacion",
      "Fecha_de_la_ultima_observacion",
      "Numero_de_observaciones",
      "Titulo_de_la_serie",
      "Fuente",
      "Notas"
    )

    # Remove the upstream header after assigning stable column names.
    names(catalog_load) <- names_catalog
    catalog_load <- catalog_load[-1, ]

    catalog_load <- bde_hlp_tochar(catalog_load)
    catalog_load
  })

  res_all <- unlist(lapply(final_catalog, is.null))

  if (any(res_all)) {
    cats <- catalog_to_load[res_all] # nolint
    ncats <- length(cats) # nolint
    cli::cli_alert_warning("Could not load {ncats} catalog{?s}: {.val {cats}}.")
  }

  # Combine catalogs and infer column types.
  final_catalog <- dplyr::bind_rows(final_catalog)
  final_catalog <- bde_hlp_guess(
    final_catalog,
    preserve = names(final_catalog)[c(5, 15)]
  )

  # Keep the public return type stable.
  final_catalog <- tibble::as_tibble(final_catalog)

  # Parse date columns after type inference.
  if (parse_dates) {
    if (verbose) {
      cli::cli_alert_info("Parsing date columns.")
    }
    date_fields <- names(final_catalog)[grep(
      "Fecha",
      names(final_catalog),
      fixed = TRUE
    )]

    for (i in seq_along(date_fields)) {
      field <- date_fields[i]
      final_catalog[field] <- bde_parse_dates(final_catalog[[field]])
    }
  }
  final_catalog
}

#' @rdname bde_catalogs
#'
#' @encoding UTF-8
#' @export
bde_catalog_update <- function(
  catalog = c("ALL", "BE", "SI", "TC", "TI", "PB"),
  cache_dir = NULL,
  verbose = FALSE
) {
  catalog <- match_arg_pretty(catalog)
  # Validate input arguments.
  valid_catalogs <- c("BE", "SI", "TC", "TI", "PB", "ALL")
  bde_hlp_abort_if_not(
    "{.arg cache_dir} must be a {.cls character} vector or {.val NULL}." = any(
      is.null(cache_dir),
      is.character(cache_dir)
    ),
    "{.arg verbose} must be a {.cls logical} vector." = is.logical(verbose)
  )

  if (!bde_check_access()) {
    tbl <- bde_hlp_return_null()
    return(tbl)
  }

  # Honor the configured cache location before downloading files.
  cache_dir <- bde_hlp_cachedir(cache_dir = cache_dir, verbose = verbose)

  # Expand `"ALL"` to the individual catalog files.
  catalog_download <- catalog
  if ("ALL" %in% catalog) {
    catalog_download <- valid_catalogs[valid_catalogs != "ALL"]
  }

  if (verbose) {
    cli::cli_alert_info(paste0(
      "Updating {length(catalog_download)} catalog file{?s}: ",
      "{.val {catalog_download}}."
    ))
  }

  res <- lapply(catalog_download, function(x) {
    serie <- x
    base_url <- paste0(
      "https://www.bde.es/webbe/es/estadisticas/",
      "compartido/datos/csv/"
    )
    catalog_file <- paste0("catalogo_", tolower(serie), ".csv")

    full_url <- paste0(base_url, catalog_file)
    local_file <- file.path(cache_dir, catalog_file)

    # Store each catalog in the resolved cache directory.
    result <- bde_hlp_download(
      url = full_url,
      local_file = local_file,
      verbose = verbose
    )
    result
  })

  invisible(res)
}

#' @rdname bde_catalogs
#'
#' @encoding UTF-8
#' @export
bde_catalog_search <- function(pattern, ...) {
  # Reuse the catalog loader so search honors the same cache and parsing rules.
  catalog_search <- bde_catalog_load(...)

  if (nrow(catalog_search) == 0) {
    tbl <- bde_hlp_return_null()
    return(tbl)
  }

  if (!tibble::is_tibble(catalog_search)) {
    cli::cli_alert_warning(paste0(
      "Catalog data does not inherit from {.cls tbl_df}. ",
      "Try downloading it again with {.fn bde_catalog_update}."
    ))
    return(invisible())
  }

  # Search the metadata fields most useful for discovery.
  col_ind <- c(2, 3, 4, 5, 15)

  search_match_rows <- NULL
  for (i in col_ind) {
    search_match_rows <- unique(c(
      search_match_rows,
      grep(pattern, catalog_search[[i]], ignore.case = TRUE, useBytes = TRUE)
    ))
  }

  search_results <- catalog_search[search_match_rows, ]
  if (nrow(search_results) == 0) {
    cli::cli_abort("No matches found for {.arg pattern} {.str {pattern}}.")
  }
  search_results
}