Nothing
#' Download one data series
#'
#' @importFrom dplyr %>% bind_rows
#'
#' @noRd
imf_data_one <- function(database_id, indicator, country, start,
end, freq, return_raw, print_url)
{
. <- NULL
# Sanity check
freq <- toupper(freq)
if (!(freq %in% c('A', 'Q', 'M'))) stop("freq must be 'A', 'Q', or 'M'.",
call. = FALSE)
# Download
## Address IMF download limit on individual call
country <- split(country, ceiling(seq_along(country) / 60))
comb_dl <- data.frame()
for (u in 1:length(country)) {
country_sub <- country[u] %>% unlist
country_sub <- paste(country_sub, sep = '', collapse = '+')
URL <- sprintf(
'http://dataservices.imf.org/REST/SDMX_JSON.svc/CompactData/%s/.%s.%s?startPeriod=%s&endPeriod=%s',
database_id, country_sub, indicator, start, end)
if (print_url) message(sprintf('Attempting to download from: %s', URL))
raw_dl <- download_parse(URL)
if (isTRUE(return_raw)) {
if (length(country) > 1) message('Only returning data for the first 60 countries.')
return(raw_dl)
} else
# Check if requested indicator and frequency is available
overview <- raw_dl$CompactData$DataSet$Series
if (is.null(overview)) {
sprintf(
'%s is not available for your query.', indicator)
next
}
available_freq <- overview$`@FREQ`
if (!(freq %in% available_freq)) {
sprintf(
'%s is not available in the requested frequency', indicator)
next
}
# Extract requested series
observations <- raw_dl$CompactData$DataSet$Series$Obs
if (!is.null(observations)) {
series_pos <- grep(freq, available_freq)
all <- 1:length(observations)
not_null <- all[sapply(observations, isnt.null)]
series_pos <- series_pos[series_pos %in% not_null]
countries <- overview$`@REF_AREA`[series_pos]
if (inherits(observations, what = "list")) {
sub_data <- observations[series_pos]
suppressWarnings(
sub_data <- sub_data %>%
lapply(as.data.frame, stringsAsFactors = FALSE) %>%
Map(cbind, ., iso2c = countries) %>%
do.call(bind_rows, .) %>%
MoveFront('iso2c')
)
}
else if (inherits(observations, what = "data.frame")) {
sub_data <- observations
if (length(countries) == 1) {
sub_data$iso2c <- countries
sub_data <- MoveFront(sub_data, 'iso2c')
}
else {
stop("Encountered unexpected data", call. = FALSE)
}
}
sub_data <- sub_data[, 1:3]
# Final clean up
if (freq == 'A') {
names(sub_data)[1:3] <- c('iso2c', 'year', indicator)
}
else if (freq == 'Q') {
names(sub_data)[1:3] <- c('iso2c', 'year_quarter', indicator)
}
else if (freq == 'M') {
names(sub_data)[1:3] <- c('iso2c', 'year_month', indicator)
}
sub_data[, 'iso2c'] <- sub_data[, 'iso2c'] %>% as.character
sub_data[, indicator] <- sub_data[, indicator] %>% as.numeric
comb_dl <- rbind(comb_dl, sub_data)
if (!isTRUE(last_element(u, 1:length(country)))) Sys.sleep(2)
}
if (nrow(comb_dl) >= 1) comb_dl <- comb_dl[order(comb_dl$iso2c), ]
}
return(comb_dl)
}
#' Simplify downloading and parsing JSON content
#'
#' @importFrom httr RETRY content progress user_agent
#' @importFrom dplyr %>%
#' @importFrom jsonlite fromJSON
#' @noRd
download_parse <- function(URL, times = 3) {
raw_download <- RETRY('GET', URL, user_agent(''), progress(), times = times) %>%
content(type = 'text', encoding = 'UTF-8')
if (grepl('<!DOCTYPE html PUBLIC', raw_download)) {
stop('data.imf.org appears to be down.', call. = FALSE)
}
if (grepl('<!DOCTYPE HTML PUBLIC', raw_download)) {
stop('Unable to download series.', call. = FALSE)
}
if (grepl('<!DOCTYPE html>', raw_download)) {
stop('Unable to download series.', call. = FALSE)
}
if (grepl('<string xmlns="http://schemas.m', raw_download)) {
stop("Unable to find what you're looking for.", call. = FALSE)
}
json_parsed <- fromJSON(raw_download)
return(json_parsed)
}
#' Move variables to the beginning of a data frame.
#'
#' @source DataCombine package
#' @noRd
MoveFront <- function(data, Var, exact = TRUE, ignore.case = NULL, fixed = NULL)
{
if (isTRUE(exact) & !is.null(ignore.case) | !is.null(fixed)){
warning('When exact = TRUE ignore.case and fixed are ignored.')
}
OneMove <- function(data, Var){
# Determine if Var exists in data
DataNames <- names(data)
TestExist <- Var %in% DataNames
if (!isTRUE(TestExist)){
stop(paste(Var, "was not found in the data frame."))
}
if (isTRUE(exact)){
col_idx <- which(DataNames %in% Var, arr.ind = TRUE)
}
else if (!isTRUE(exact)){
col_idx <- grep(Var, DataNames, ignore.case = ignore.case,
fixed = fixed)
}
MovedData <- data[, c(col_idx, (1:ncol(data))[-col_idx])]
return(MovedData)
}
RevVar <- rev(Var)
for (i in RevVar){
data <- OneMove(data, i)
}
return(data)
}
#' Find last element of a vector
#'
#' @noRd
last_element <- function(x, v)
{
x_position <- match(x, v)
v_final <- length(v)
if (x_position == v_final) return(TRUE)
else return(FALSE)
}
#' All ISO2C codes
#'
#' @noRd
all_iso2c <- function() {
all <- imfr::all_iso2c
return(all[, 1])
}
#' Test if not NULL
#' @noRd
isnt.null <- function(x)!is.null(x)
#' Return current year
#' @export
current_year <- function() {
y <- substr(Sys.Date(), start = 1, stop = 4)
y <- as.numeric(y)
return(y)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.