#' Download DBnomics data.
#'
#' \code{rdb} downloads data series from
#' \href{https://db.nomics.world/}{DBnomics} using shortcuts like \code{ids},
#' \code{dimensions}, \code{mask}, \code{query} or using an \code{api_link}.
#'
#' This function gives you access to hundreds of millions data series from
#' \href{https://api.db.nomics.world/}{DBnomics API} (documentation about
#' the API can be found \href{https://api.db.nomics.world/v22/apidocs}{here}).
#' The code of each series is given on the
#' \href{https://db.nomics.world/}{DBnomics website}. \cr\cr
#' In the event that only the argument \code{ids} is provided (and those in the
#' ellipsis \code{...}), the argument name can be dropped. The character string
#' vector is directly passed to \code{ids}. \cr
#' If only the argument \code{api_link} is provided (and those in the
#' ellipsis \code{...}), then the argument name can be dropped. The character string
#' vector is directly passed to \code{api_link}. \cr
#' In the same way, if only \code{provider_code}, \code{dataset_code} and
#' \code{mask} are provided then the arguments names can be dropped. The
#' last character string is automatically passed to \code{mask}.
#'
#'
#' @param provider_code Character string (default \code{NULL}). DBnomics code
#' of the provider.
#' @param dataset_code Character string (default \code{NULL}). DBnomics code
#' of the dataset.
#' @param ids Character string (default \code{NULL}). DBnomics code of one or
#' several series.
#' @param dimensions List or character string (single quoted) (default \code{NULL}).
#' DBnomics code of one or several dimensions in the specified provider and dataset.
#' If it is a named list, then the function \code{toJSON} (from the
#' package \pkg{jsonlite}) is applied to generate the json object.
#' @param mask Character string (default \code{NULL}). DBnomics code of one or
#' several masks in the specified provider and dataset.
#' @param query Character string (default \code{NULL}). A query to
#' filter/select series from a provider's dataset.
#' @param api_link Character string. DBnomics API link of the search. It should
#' starts with \code{http://} or \code{https://}.
#' @param filters List (default \code{NULL}). This argument must be a named
#' list for one filter because the function \code{toJSON} of the package \pkg{jsonlite}
#' is used before sending the request to the server. For multiple filters,
#' you have to provide a list of valid filters (see examples).\cr
#' A valid filter is a named list with an element \code{code} which is a character string,
#' and an element \code{parameters} which is a named list with elements \code{frequency}
#' and \code{method} or a NULL.
#' @param use_readLines Logical (default \code{FALSE}). If \code{TRUE}, then
#' the data are requested and read with the base function \code{readLines} i.e.
#' through the default R internet connection. This can be used to get round the
#' error \code{Could not resolve host: api.db.nomics.world}.
#' @param curl_config Named list (default \code{NULL}). If not
#' \code{NULL}, it is used to configure a proxy connection. This
#' configuration is passed to the function \code{curl_fetch_memory} of the package
#' \pkg{curl}. A temporary \code{curl_handle} object is created internally
#' with arguments equal to the provided list in \code{curl_config}.\cr
#' For \code{curl_fetch_memory} arguments see \code{\link[curl]{curl_fetch}}.
#' For available curl options see \code{\link[curl]{curl_options}},
#' \code{names(curl_options())} and
#' \href{https://curl.haxx.se/libcurl/c/curl_easy_setopt.html}{libcurl}.
#' @param verbose Logical (default \code{FALSE}). Show warnings of the function.
#' @param ... Arguments to be passed to the internal function \code{.rdb}.
#' @return A \code{data.table}.
#' @examples
#' \dontrun{
#' ## By ids
#' # Fetch one series from dataset 'Unemployment rate' (ZUTN) of AMECO provider:
#' df1 <- rdb(ids = "AMECO/ZUTN/EA19.1.0.0.0.ZUTN")
#' # or when no argument names are given (provider_code -> ids)
#' df1 <- rdb("AMECO/ZUTN/EA19.1.0.0.0.ZUTN")
#'
#' # Fetch two series from dataset 'Unemployment rate' (ZUTN) of AMECO provider:
#' df2 <- rdb(ids = c("AMECO/ZUTN/EA19.1.0.0.0.ZUTN", "AMECO/ZUTN/DNK.1.0.0.0.ZUTN"))
#'
#' # Fetch two series from different datasets of different providers:
#' df3 <- rdb(ids = c("AMECO/ZUTN/EA19.1.0.0.0.ZUTN", "IMF/BOP/A.FR.BCA_BP6_EUR"))
#'
#'
#' ## By dimensions
#' # Fetch one value of one dimension from dataset 'Unemployment rate' (ZUTN) of AMECO provider:
#' df1 <- rdb("AMECO", "ZUTN", dimensions = list(geo = "ea12"))
#' # or
#' df1 <- rdb("AMECO", "ZUTN", dimensions = '{"geo":["ea12"]}')
#'
#' # Fetch two values of one dimension from dataset 'Unemployment rate' (ZUTN) of AMECO provider:
#' df2 <- rdb("AMECO", "ZUTN", dimensions = list(geo = c("ea12", "dnk")))
#' # or
#' df2 <- rdb("AMECO", "ZUTN", dimensions = '{"geo":["ea12","dnk"]}')
#'
#' # Fetch several values of several dimensions from dataset 'Doing business' (DB) of World Bank:
#' dim <- list(
#' country = c("DZ", "PE"),
#' indicator = c("ENF.CONT.COEN.COST.ZS", "IC.REG.COST.PC.FE.ZS")
#' )
#' df3 <- rdb("WB", "DB", dimensions = dim)
#' # or
#' dim <- paste0(
#' '{"country":["DZ","PE"],',
#' '"indicator":["ENF.CONT.COEN.COST.ZS","IC.REG.COST.PC.FE.ZS"]}'
#' )
#' df3 <- rdb("WB", "DB", dimensions = dim)
#'
#'
#' ## By mask
#' # Fetch one series from dataset 'Balance of Payments' (BOP) of IMF:
#' df1 <- rdb("IMF", "BOP", mask = "A.FR.BCA_BP6_EUR")
#' # or when no argument names are given except provider_code and dataset_code (ids -> mask)
#' df1 <- rdb("IMF", "BOP", "A.FR.BCA_BP6_EUR")
#'
#' # Fetch two series from dataset 'Balance of Payments' (BOP) of IMF:
#' df2 <- rdb("IMF", "BOP", mask = "A.FR+ES.BCA_BP6_EUR")
#'
#' # Fetch all series along one dimension from dataset 'Balance of Payments' (BOP) of IMF:
#' df3 <- rdb("IMF", "BOP", mask = "A..BCA_BP6_EUR")
#'
#' # Fetch series along multiple dimensions from dataset 'Balance of Payments' (BOP) of IMF:
#' df4 <- rdb("IMF", "BOP", mask = "A.FR.BCA_BP6_EUR+IA_BP6_EUR")
#'
#'
#' ## By query
#' # Fetch one series from dataset 'WEO by countries (2019-10 release)' (WEO:2019-10) from IMF :
#' df1 <- rdb("IMF", "WEO:2019-10", query = "France current account balance percent")
#' # Fetch series from dataset 'WEO by countries (2019-10 release)' (WEO:2019-10) from IMF :
#' df2 <- rdb("IMF", "WEO:2019-10", query = "current account balance percent")
#'
#'
#' ## By api_link
#' # Fetch two series from different datasets of different providers :
#' df1 <- rdb(
#' api_link = paste0(
#' "https://api.db.nomics.world/v22/",
#' "series?observations=1&series_ids=AMECO/ZUTN/EA19.1.0.0.0.ZUTN,IMF/CPI/A.AT.PCPIT_IX"
#' )
#' )
#'
#' # Fetch one series from the dataset 'Doing Business' of WB provider :
#' df2 <- rdb(
#' api_link = paste0(
#' "https://api.db.nomics.world/v22/series/WB/DB?dimensions=%7B%22",
#' "indicator%22%3A%5B%22IC.REG.PROC.FE.NO%22%5D%7D&q=Doing%20Business",
#' "&observations=1&format=json&align_periods=1&offset=0&facets=0"
#' )
#' )
#' # or when no argument names are given (provider_code -> api_link)
#' df1 <- rdb(
#' paste0(
#' "https://api.db.nomics.world/v22/",
#' "series?observations=1&series_ids=AMECO/ZUTN/EA19.1.0.0.0.ZUTN,IMF/CPI/A.AT.PCPIT_IX"
#' )
#' )
#'
#'
#' ## Use a specific proxy to fetch the data
#' # Fetch one series from dataset 'Unemployment rate' (ZUTN) of AMECO provider :
#' h <- list(
#' proxy = "<proxy>",
#' proxyport = <port>,
#' proxyusername = "<username>",
#' proxypassword = "<password>"
#' )
#' options(rdbnomics.curl_config = h)
#' df1 <- rdb(ids = "AMECO/ZUTN/EA19.1.0.0.0.ZUTN")
#' # or to use once
#' options(rdbnomics.curl_config = NULL)
#' df1 <- rdb(ids = "AMECO/ZUTN/EA19.1.0.0.0.ZUTN", curl_config = h)
#'
#'
#' ## Use R default connection to avoid a proxy failure (in some cases)
#' # Fetch one series from dataset 'Unemployment rate' (ZUTN) of AMECO provider :
#' options(rdbnomics.use_readLines = TRUE)
#' df1 <- rdb(ids = "AMECO/ZUTN/EA19.1.0.0.0.ZUTN")
#' # or to use once
#' df1 <- rdb(ids = "AMECO/ZUTN/EA19.1.0.0.0.ZUTN", use_readLines = TRUE)
#'
#'
#' ## Apply filter(s) to the series
#' # One filter
#' df1 <- rdb(
#' ids = c("IMF/WEO:2019-10/ABW.BCA.us_dollars", "IMF/WEO:2019-10/ABW.BCA_NGDPD.pcent_gdp"),
#' filters = list(
#' code = "interpolate",
#' parameters = list(frequency = "daily", method = "spline")
#' )
#' )
#'
#' # Two filters
#' df1 <- rdb(
#' ids = c("IMF/WEO:2019-10/ABW.BCA.us_dollars", "IMF/WEO:2019-10/ABW.BCA_NGDPD.pcent_gdp"),
#' filters = list(
#' list(
#' code = "interpolate",
#' parameters = list(frequency = "quarterly", method = "spline")
#' ),
#' list(
#' code = "aggregate",
#' parameters = list(frequency = "annual", method = "average")
#' )
#' )
#' )
#' }
#' @author Sebastien Galais
#' @export
rdb <- function(
provider_code = NULL, dataset_code = NULL,
ids = NULL, dimensions = NULL, mask = NULL, query = NULL, api_link = NULL,
filters = getOption("rdbnomics.filters"),
use_readLines = getOption("rdbnomics.use_readLines"),
curl_config = getOption("rdbnomics.curl_config"),
verbose = getOption("rdbnomics.verbose_warning"),
...
) {
# Checking 'verbose'
check_argument(verbose, "logical")
# Setting API url
api_base_url <- getOption("rdbnomics.api_base_url")
check_argument(api_base_url, "character")
# Setting API version
api_version <- getOption("rdbnomics.api_version")
check_argument(api_version, c("numeric", "integer"))
authorized_version(api_version)
# Setting API metadata
metadata <- getOption("rdbnomics.metadata")
check_argument(metadata, "logical")
# Building API base url
api_base_url <- paste0(api_base_url, "/v", api_version, "/series")
# Checking arguments
provider_code_null <- is.null(provider_code)
provider_code_not_null <- !provider_code_null
dataset_code_null <- is.null(dataset_code)
dataset_code_not_null <- !dataset_code_null
dimensions_null <- is.null(dimensions)
dimensions_not_null <- !dimensions_null
mask_null <- is.null(mask)
mask_not_null <- !mask_null
ids_null <- is.null(ids)
ids_not_null <- !ids_null
query_null <- is.null(query)
query_not_null <- !query_null
api_link_null <- is.null(api_link)
api_link_not_null <- !api_link_null
# provider_code is considered as api_link in some cases
if (
provider_code_not_null & dataset_code_null & dimensions_null & mask_null &
ids_null & query_null & api_link_null & getOption("rdbnomics.rdb_no_arg")
) {
is_http <- grepl("^http(s)*://", tolower(provider_code))
if (sum(is_http, na.rm = TRUE) > 0) {
fcall <- sys.call()
modif_arg <- call_ok(fcall)
if (modif_arg) {
api_link <- provider_code
provider_code <- NULL
provider_code_null <- TRUE
provider_code_not_null <- !provider_code_null
api_link_null <- FALSE
api_link_not_null <- !api_link_null
}
}
}
# By api_link i.e. .rdb(api_link = api_link)
if (api_link_not_null) {
check_argument(api_link, "character", not_null = FALSE)
if (api_version == 22) {
return(
.rdb(
api_link = api_link, filters = filters,
use_readLines = use_readLines, curl_config = curl_config, ...
)
)
} else {
stop(
paste0("Don't know what to do for API version ", api_version, "."),
call. = FALSE
)
}
}
# provider_code is considered as ids in some cases
if (
provider_code_not_null & dataset_code_null & dimensions_null & mask_null &
ids_null & query_null & api_link_null & getOption("rdbnomics.rdb_no_arg")
) {
fcall <- sys.call()
modif_arg <- call_ok(fcall)
if (modif_arg) {
ids <- provider_code
provider_code <- NULL
provider_code_null <- TRUE
provider_code_not_null <- !provider_code_null
ids_null <- FALSE
ids_not_null <- !ids_null
}
}
# ids is considered as mask in some cases
if (
provider_code_not_null & dataset_code_not_null & dimensions_null &
mask_null & ids_not_null & query_null & api_link_null &
getOption("rdbnomics.rdb_no_arg")
) {
fcall <- sys.call()
modif_arg <- call_ok(fcall)
if (modif_arg) {
mask <- ids
ids <- NULL
mask_null <- FALSE
mask_not_null <- !mask_null
ids_null <- TRUE
ids_not_null <- !ids_null
}
}
# By dimensions
if (dimensions_not_null) {
if (provider_code_null | dataset_code_null) {
stop(
paste0(
"When you filter with 'dimensions', you must specifiy ",
"'provider_code' and 'dataset_code' as arguments of the function."
),
call. = FALSE
)
}
dimensions <- to_json_if_list(dimensions)
check_argument(dimensions, c("character", "json"), not_null = FALSE)
check_argument(provider_code, "character", not_null = FALSE)
check_argument(dataset_code, "character", not_null = FALSE)
if (api_version == 21) {
link <- paste0(
api_base_url, "?provider_code=", provider_code,
"&dataset_code=", dataset_code, "&dimensions=", dimensions
)
} else if (api_version == 22) {
link <- paste0(
api_base_url, "/", provider_code, "/", dataset_code,
ifelse(metadata, "?", paste0("?metadata=", as.numeric(metadata), "&")),
"observations=1&dimensions=", dimensions
)
} else {
stop(
paste0("Don't know what to do for API version ", api_version, "."),
call. = FALSE
)
}
return(
.rdb(
api_link = link, filters = filters,
use_readLines = use_readLines, curl_config = curl_config, ...
)
)
}
# By mask
if (mask_not_null) {
if (provider_code_null | dataset_code_null) {
stop(
paste0(
"When you filter with 'mask', you must specifiy 'provider_code' ",
"and 'dataset_code' as arguments of the function."
),
call. = FALSE
)
}
check_argument(mask, "character", not_null = FALSE)
check_argument(provider_code, "character", not_null = FALSE)
check_argument(dataset_code, "character", not_null = FALSE)
if (api_version == 21) {
link <- paste0(
api_base_url, "?provider_code=", provider_code,
"&dataset_code=", dataset_code, "&series_code_mask=", mask
)
} else if (api_version == 22) {
link <- paste0(
api_base_url, "/", provider_code, "/", dataset_code,
"/", mask,
ifelse(metadata, "?", paste0("?metadata=", as.numeric(metadata), "&")),
"observations=1"
)
} else {
stop(
paste0("Don't know what to do for API version ", api_version, "."),
call. = FALSE
)
}
return(
.rdb(
api_link = link, filters = filters,
use_readLines = use_readLines, curl_config = curl_config, ...
)
)
}
# By ids
if (ids_not_null) {
if (provider_code_not_null | dataset_code_not_null) {
if (verbose) {
warning(
paste0(
"When you filter with 'ids', ",
"'provider_code' and 'dataset_code' are not considered."
)
)
}
}
if (!is.character(ids)) {
stop("'ids' must be of class 'character'.", call. = FALSE)
}
if (length(ids) <= 0) {
stop("'ids' is empty.", call. = FALSE)
}
if (api_version == 21) {
link <- paste0(
api_base_url, "?series_ids=", paste(ids, collapse = ",")
)
} else if (api_version == 22) {
link <- paste0(
api_base_url,
ifelse(metadata, "?", paste0("?metadata=", as.numeric(metadata), "&")),
"observations=1&series_ids=",
paste(ids, collapse = ",")
)
} else {
stop(
paste0("Don't know what to do for API version ", api_version, "."),
call. = FALSE
)
}
return(
.rdb(
api_link = link, filters = filters,
use_readLines = use_readLines, curl_config = curl_config, ...
)
)
}
# By query
if (query_not_null) {
if (provider_code_null | dataset_code_null) {
stop(
paste0(
"When you filter with a 'query', you must specifiy 'provider_code' ",
"and 'dataset_code' as arguments of the function."
),
call. = FALSE
)
}
check_argument(query, "character", not_null = FALSE)
if (verbose) {
if (query == "") {
warning(
paste0(
"Your 'query' is empty, the entire dataset ",
provider_code, "/", dataset_code,
" will be downloaded. It can be long !"
)
)
}
}
if (api_version == 22) {
link <- paste0(
api_base_url, "/", provider_code, "/", dataset_code,
"?q=", utils::URLencode(query),
ifelse(metadata, "&", paste0("&metadata=", as.numeric(metadata), "&")),
"observations=1"
)
} else {
stop(
paste0("Don't know what to do for API version ", api_version, "."),
call. = FALSE
)
}
return(
.rdb(
api_link = link, filters = filters,
use_readLines = use_readLines, curl_config = curl_config, ...
)
)
}
stop(
"Please provide correct 'provider_code', 'dataset_code', 'dimensions', ",
"'mask', 'ids', 'query', 'api_link' or 'filters'.",
call. = FALSE
)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.