R/download-wid.R

In wid: Download Data from the World Inequality Database

#' @title Download data from WID.world
#'
#' @author Thomas Blanchet, with updates by Ignacio Flores
#'
#' @description Downloads data from the World Wealth and Income Database
#' (\url{https://wid.world}) into a \code{data.frame}.
#' Type \code{vignette("wid-demo")} for a detailed presentation.
#'
#' @param indicators List of six-letter strings, or \code{"all"}:
#' code names of the indicators in the database. Default is \code{"all"} for all
#' indicators. See 'Details' for more.
#' @param areas List of strings, or \code{"all"}: area code names of the
#' database. \code{"XX"} for countries/regions, 
#' \code{"XX-YY"} for infra-national regions. \code{"XX-YYY"} for supra-national regions.
#' Default is \code{"all"} for all areas. See 'Details' for more.
#' @param perc List of strings, or \code{"all"}: percentiles take the form
#' \code{"pXX"} or \code{"pXXpYY"}. Default is \code{"all"} for all percentiles.
#' See 'Details' for more.
#' @param years Numerical vector, or \code{"all"}: years to retrieve.
#' Default is \code{"all"} for all years.
#' @param ages Numerical vector, or \code{"all"}: age category codes in the
#' database. 999 for all ages, 992 for adults. Default is \code{"all"} for all
#' age categories. See 'Details' for more.
#' @param pop List of characters, or \code{"all"}: type of population.
#' \code{"t"} for tax units, \code{"i"} for individuals. Default is
#' \code{"all"} for all population types. See 'Details' for more.
#' @param metadata Should the function fetch metadata too (ie. variable
#' descriptions, sources, methodological notes, etc.)? Default is \code{FALSE}.
#' @param score_filter Optional data quality score filter. A single number is
#' interpreted as a minimum \code{row_score}. You can also use a named list with
#' \code{row_score} and/or \code{series_score}; each value can be a minimum, a
#' two-number inclusive range, or a list with \code{min} and/or \code{max}.
#' @param verbose Should the function indicate the progress of the request?
#' Default is \code{FALSE}.
#'
#' @details
#'
#' Although all arguments default to \code{"all"}, you cannot download the
#' entire database by typing \code{download_wid()}. The command requires you
#' to specify either some indicators or some areas. \strong{To download the entire
#' database, please visit \url{https://wid.world/data/} and choose "download
#' full dataset".}
#'
#' If there is no data matching you selection on WID.world (maybe because
#' you specified an indicator or an area that doesn't exist), the command
#' will return \code{NULL} with a warning.
#'
#' All monetary amounts for countries and country subregions are in constant
#' local currency of the reference year (i.e. the previous year, the database
#' being updated every year around July). Monetary amounts for world regions
#' are in EUR PPP of the reference year. You can access the price index using
#' the indicator \code{inyixx}, the PPP exchange rates using \code{xlcusp}
#' (USD), \code{xlceup} (EUR), \code{xlcyup} (CNY), and the market exchange
#' rates using \code{xlcusx} (USD), \code{xlceux} (EUR), \code{xlcyux}
#' (CNY). To check the current reference year, you can look at when the price
#' index is equal to 1.
#'
#' Shares and wealth/income ratios are given as a fraction of 1. That is,
#' a top 1\% share of 20\% is given as 0.2. A wealth/income ratio of
#' 300\% is given as 3.
#'
#' The arguments of the command follow a nomenclature specific to WID.world.
#' We provide more details with a few examples below. \strong{For the complete
#' up-to-date documentation of the structure of the database, please visit
#' \url{https://wid.world/codes-dictionary/}.}
#'
#' \subsection{Indicators}{
#' The argument \code{indicators} is a vector of 6-letter codes that corresponds to a
#' given series type for a given income or wealth concept. The first letter
#' correspond to the type of series. Some of the most common possibilities include:
#' \tabular{rcl}{
#' \bold{one-letter code} \tab      \tab \bold{description}     \cr
#' \code{a} \tab      \tab average (local currency unit, last year’s prices) \cr
#' \code{b} \tab      \tab inverted Pareto-Lorenz coefficient \cr
#' \code{f} \tab      \tab female population (fraction between 0 and 1) \cr
#' \code{g} \tab      \tab Gini coefficient (between 0 and 1) \cr
#' \code{i} \tab      \tab index \cr
#' \code{n} \tab      \tab population \cr
#' \code{s} \tab      \tab share (fraction between 0 and 1) \cr
#' \code{t} \tab      \tab threshold (local currency unit, last year’s prices) \cr
#' \code{m} \tab      \tab total (local currency unit, last year’s prices) \cr
#' \code{p} \tab      \tab proportion of women (fraction between 0 and 1) \cr
#' \code{w} \tab      \tab wealth-to-income ratio or labor/capital share (fraction of national income) \cr
#' \code{r} \tab      \tab Top 10/Bottom 50 ratio  \cr
#' \code{x} \tab      \tab exchange rate (market or PPP)  \cr
#' \code{e} \tab      \tab Total emissions (tons of CO2 equivalent emissions) \cr
#' \code{k} \tab      \tab Per capita emissions (tons of CO2 equivalent emissions) \cr
#' \code{l} \tab      \tab Average per capita group emissions (tons of CO2 equivalent per capita emissions) \cr
#' }
#'
#' The next five letters correspond a concept (usually of income and wealth).
#' Some of the most common possibilities include:
#' \tabular{rcl}{
#' \bold{five-letter code} \tab      \tab \bold{description} \cr
#' \code{ptinc} \tab      \tab pre-tax national income \cr
#' \code{pllin} \tab      \tab pre-tax labor income    \cr
#' \code{pkkin} \tab      \tab pre-tax capital income  \cr
#' \code{fiinc} \tab      \tab fiscal income           \cr
#' \code{hweal} \tab      \tab net personal wealth     \cr
#' }
#'
#' For example, \code{sfiinc} corresponds to the share of fiscal income,
#' \code{ahweal} corresponds to average personal wealth. If you don't specify
#' any indicator, it defaults to \code{"all"} and downloads all available indicators. 
#' Check \url{https://wid.world/codes-dictionary/} for a full list of codes.
#' }
#'
#' \subsection{Area codes}{
#' All data in WID.world is associated to a given area, which can be a country,
#' a region within a country, an aggregation of countries (eg. a continent), or
#' even the whole world. The argument \code{areas} is a vector of codes that specify
#' the areas for which to retrieve data. Countries and world regions are coded
#' using 2-letter ISO codes. Country subregions are coded as \code{XX-YY}
#' where \code{XX} is the country 2-letter code. If you don't specify any area,
#' it defaults to \code{"all"} and downloads data for all available areas.
#' }
#'
#' \subsection{Years}{
#' All data in WID.world correspond to a year. Some series go as far back as
#' the 1800s. The argument \code{years} is a vector of integer that specify
#' those years. If you don't specify any year, it defaults to \code{"all"}
#' and downloads data for all available years.
#' }
#'
#' \subsection{Percentiles}{
#' The key feature of WID.world is that it provides data on the whole
#' distribution, not just totals and averages. The argument \code{perc}
#' is a vector of strings that indicate for which part of the distribution
#' the data should be retrieved. For share and average variables,
#' percentiles correspond to percentile ranges and take the form \code{pXXpYY}.
#' For example the top 1\% share correspond to \code{p99p100}. The top 10\% share
#' excluding the top 1\% is \code{p90p99}. Thresholds associated to the
#' percentile group \code{pXXpYY} correspond to the minimal income or wealth
#' level that gets you into the group. For example, the threshold of the
#' percentile group \code{p90p100} or \code{p90p91} correspond to the 90\%
#' quantile. Variables with no distributional meaning use the percentile p0p100.
#' If you don't specify any percentile, it defaults to \code{"all"} and
#' downloads data for all available parts of the distribution.
#' }
#'
#' \subsection{Age groups}{
#' Data may only concern the population in a certain age group.
#' The argument \code{ages} is a vector of age codes that specify which
#' age categories to retrieve. Ages are coded using 3-digit codes.
#' Some of the most common possibilities include:
#' \tabular{rcl}{
#' \bold{three-digit code} \tab      \tab \bold{description} \cr
#' \code{999} \tab      \tab all ages \cr
#' \code{014} \tab      \tab ages 0 to 14 \cr
#' \code{156} \tab      \tab ages 15 to 64 \cr
#' \code{997} \tab      \tab ages 65 and older \cr
#' \code{991} \tab      \tab ages below 20 \cr
#' \code{992} \tab      \tab ages 20 and older \cr
#' }
#' If you don't specify any age, it defaults to \code{"all"} and downloads
#' data for all available age groups. Visit \url{https://wid.world/codes-dictionary/}
#' for a comprehensive list of options.
#' }
#'
#' \subsection{Population types}{
#' The data in WID.world can refer to different types of population
#' (i.e. different statistical units). The argument \code{pop} is a vector of
#' population codes. They are coded using one-letter codes. Some of the
#' most common possibilities include:
#' \tabular{rcl}{
#' \bold{one-letter code} \tab      \tab \bold{description} \cr
#' \code{i} \tab      \tab individuals \cr
#' \code{j} \tab      \tab equal-split adults (i.e., income or wealth divided equally among spouses) \cr
#' \code{m} \tab      \tab male \cr
#' \code{f} \tab      \tab female \cr
#' \code{t} \tab      \tab tax unit \cr
#' \code{e} \tab      \tab employed \cr
#' }
#' If you don't specify any code, it defaults to \code{"all"}
#' and downloads data for all available populations.
#' }
#'
#' \subsection{Data quality score filters}{
#' Use \code{score_filter} to keep observations or country-series above a data
#' quality threshold. For example, \code{score_filter = 3} keeps observations
#' with \code{row_score >= 3}, while \code{score_filter = list(series_score = 4)}
#' keeps country-series with \code{series_score >= 4}. A two-number vector gives
#' an inclusive range, e.g. \code{list(row_score = c(3, 5))}.
#' }
#'
#' @return A \code{data.frame} with the following columns:
#' \describe{
#'     \item{\code{country}}{The country or area code.}
#'     \item{\code{variable}}{The variable name, which combine the indicator,
#'     the age code and the population code.}
#'     \item{\code{percentile}}{The part of the distribution the value relates to.}
#'     \item{\code{year}}{The year the value relates to.}
#'     \item{\code{value}}{The value of the indicator.}
#' }
#' If you specify \code{metadata = TRUE}, the \code{data.frame} also has the
#' following columns:
#' \describe{
#'     \item{\code{countryname}}{The full name of the country/region.}
#'     \item{\code{shortname}}{A short version of the variable full name in plain english.}
#'     \item{\code{shortdes}}{A description of the type of series.}
#'     \item{\code{pop}}{The population type, in plain english.}
#'     \item{\code{age}}{The age group, in plain english.}
#'     \item{\code{source}}{The source for the data.}
#'     \item{\code{row_score}}{Observation-level data quality score. Since
#'         2026, this score varies by country, series, and year.}
#'     \item{\code{series_score}}{Country-series data quality score. It is a
#'         weighted average of \code{row_score} over years, with greater weight
#'         on more recent observations.}
#'     \item{\code{method}}{Methodological notes, if any.}
#' }
#'
#' @importFrom plyr ddply ldply
#'
#' @export

download_wid <- function(indicators = "all", areas = "all", years = "all", perc = "all",
                         ages = "all", pop = "all", metadata = FALSE,
                         score_filter = NULL, verbose = FALSE) {
  
    if (identical(indicators, "all") && identical(areas, "all")) {
      stop("you must select at least some specific indicators, areas, or both.")
    }

    # Check the format of arguments
    check_indicators(indicators)
    check_areas(areas)
    check_years(years)
    check_perc(perc)
    check_ages(ages)
    check_pop(pop)
    score_filter <- normalize_score_filter(score_filter)
    score_filter_columns <- intersect(c("row_score", "series_score"), names(score_filter))
    needs_metadata <- metadata || "series_score" %in% score_filter_columns

    if (verbose) {
        cat("* Get variables associated to your selection...")
    }

    # Get the variables associated to the area(s)
    variables <- ldply(indicators, function(sixlet) get_variables_areas(areas, sixlet))

    # If empty response, return NULL
    if (nrow(variables) == 0) {
        if (verbose) {
            cat("DONE\n")
            cat("(no data matching your selection)\n")
        }
        warning("no data matching selection")
        return(NULL)
    }

    # data.frame of specified indicators
    if (length(indicators) == 1 && indicators == "all") {
        df_indicators <- NULL
    } else {
        df_indicators <- data.frame(variable = indicators)
    }
    # data.frame of specified percentiles
    if (length(perc) == 1 && perc == "all") {
        df_perc <- NULL
    } else {
        df_perc <- data.frame(percentile = perc)
    }
    # data.frame of ages
    if (length(ages) == 1 && ages == "all") {
        df_ages <- NULL
    } else {
        df_ages <- data.frame(age = ages)
    }
    # data.frame of population codes
    if (length(pop) == 1 && pop == "all") {
        df_pop <- NULL
    } else {
        df_pop <- data.frame(pop = pop)
    }

    # Only keep the variables that match the user selection
    if (!is.null(df_indicators)) {
        variables <- merge(variables, df_indicators, by = "variable", all.x = FALSE, all.y = FALSE)
    }
    if (!is.null(df_perc)) {
        variables <- merge(variables, df_perc, by = "percentile", all.x = FALSE, all.y = FALSE)
    }
    if (!is.null(df_ages)) {
        variables <- merge(variables, df_ages, by = "age", all.x = FALSE, all.y = FALSE)
    }
    if (!is.null(df_pop)) {
        variables <- merge(variables, df_pop, by = "pop", all.x = FALSE, all.y = FALSE)
    }

    # Check that there are some data left
    if (nrow(variables) == 1 && all(is.na(variables[1, -1]))) {
        if (verbose) {
            cat("DONE\n")
            cat("(no data matching your selection)\n")
        }
        warning("no data matching selection")
        return(NULL)
    }

    # Display how many variables remain, if requested
    if (verbose) {
        cat("DONE\n")

        nb_indicator <- length(unique(variables$variable))
        cat("(found", nb_indicator, "variable")
        if (nb_indicator > 1) {
            cat("s")
        }

        nb_country <- length(unique(variables$country))
        cat(paste(" for", nb_country, "area"))
        if (nb_country > 1) {
            cat("s")
        }

        nb_perc <- length(unique(variables$percentile))
        cat(paste(",", nb_perc, "percentile"))
        if (nb_perc > 1) {
            cat("s")
        }

        nb_age <- length(unique(variables$age))
        cat(paste(",", nb_age, "age categor"))
        if (nb_age > 1) {
            cat("ies")
        } else {
            cat("y")
        }

        nb_pop <- length(unique(variables$pop))
        cat(paste(",", nb_pop, "population categor"))
        if (nb_pop > 1) {
            cat("ies)\n")
        } else {
            cat("y)\n")
        }
        cat("* Download the data...\n")
    }

    # Generate variable names used in the API
    variables$data_codes <- paste(
        variables$variable,
        variables$percentile,
        variables$age,
        variables$pop,
        sep = "_"
    )

    # Divide the data in smaller chunks to avoid request that are too large:
    # group by variable and percentile
    variables$group <- as.numeric(factor(variables$data_codes))
    variables$chunk <- floor(variables$group/10)

    data <- ddply(variables, "chunk", function(variables) {
        query_codes <- unique(variables$data_codes)
        query_areas <- unique(variables$country)

        return(get_data_variables(query_areas, query_codes))
    }, .progress = ifelse(verbose, "text", "none"))

    # Remove potential duplicates
    data <- data[!duplicated(data[, c("country", "indicator", "year")]), ]

    # Remove years not requested
    if (!identical(years, "all")) {
        data <- data[(data$year %in% years), ]
    }

    # Extract codes without percentiles
    indicator <- t(simplify2array(strsplit(data$indicator, "_", fixed = TRUE)))
    data$variable <- paste0(indicator[, 1], indicator[, 3], indicator[, 4])
    data$percentile <- indicator[, 2]

    # Retrieve metadata, if requested or needed for score filtering
    if (needs_metadata) {
        if (verbose) {
            cat("* Download the metadata...\n")
        }

        # Metadata is percentile-invariant, but age and population metadata can
        # differ, so fetch one representative percentile per age/pop group.
        metadata_requests <- variables
        metadata_requests$metadata_codes <- paste(
            metadata_requests$variable,
            metadata_requests$percentile,
            metadata_requests$age,
            metadata_requests$pop,
            sep = "_"
        )
        metadata_requests <- metadata_requests[
            !duplicated(metadata_requests[, c("country", "variable", "age", "pop")]), ]
        metadata_requests$chunk <- floor(seq_len(nrow(metadata_requests))/50)
        collected_metadata <- list()
        
        data_metadata_list <- plyr::dlply(metadata_requests, "chunk", function(variables) {
          query_codes <- unique(variables$metadata_codes)
          query_areas <- unique(variables$country)
          
          result <- get_metadata_variables(query_areas, query_codes, report_missing = FALSE, collected_metadata)
          collected_metadata <<- result$collected_metadata  # Update global collection
          return(result$response_table)
        }, .progress = ifelse(verbose, "text", "none"))
        
        # Combine all metadata into one data frame
        data_metadata <- do.call(rbind, data_metadata_list)
        if (is.null(data_metadata)) {
            data_metadata <- empty_metadata_table()
        }
        data_metadata <- ensure_columns(data_metadata, names(empty_metadata_table()))
        
        #Print missing metadata info 
        if (length(collected_metadata) > 0) {
          message("\nMissing Metadata:")
          for (var in names(collected_metadata)) {
            cat("\n Variable:", var, "\n")
            
            # Print "Completely Missing" first, if applicable
            if ("Completely missing" %in% names(collected_metadata[[var]])) {
              cat("  Completely missing (no metadata at all):\n")
              cat("      Areas:", paste(sort(collected_metadata[[var]][["Completely missing"]]), collapse = ", "), "\n\n")
            }
            
            # Print other missing fields
            for (key in names(collected_metadata[[var]])) {
              if (key != "Completely missing") {  # Skip since we printed it already
                cat("  Missing fields:", key, "\n")
                cat("      Areas:", paste(sort(collected_metadata[[var]][[key]]), collapse = ", "), "\n\n")
              }
            }
          }
        }
        
        
        data_metadata$chunk <- NULL

        # Remove percentile from variable
        indicator <- t(simplify2array(strsplit(data_metadata$variable, "_", fixed = TRUE)))
        data_metadata$variable <- paste0(indicator[, 1], indicator[, 3], indicator[, 4])

        # Merge with the data
        data <- merge(data, data_metadata,
            by = c("variable", "country"),
            all.x = TRUE,
            all.y = FALSE
        )
        data <- ensure_columns(data, c(
            "country", "countryname", "variable", "percentile", "year", "value",
            "shortname", "shortdes", "pop", "age", "source", "row_score",
            "series_score", "method"
        ))
    }

    data <- apply_score_filter(data, score_filter)

    # Clean the up the final dataset
    data$indicator <- NULL
    data <- data[order(data$country, data$variable, data$percentile, data$year), ]
    rownames(data) <- NULL
    if (metadata) {
        data <- data[, c(
            "country", "countryname", "variable", "percentile", "year", "value",
            "shortname", "shortdes", "pop", "age", "source", "row_score",
            "series_score", "method"
        )]
    } else {
        data <- data[, c("country", "variable", "percentile", "year", "value",
            score_filter_columns)]
    }

    return(data)
}