diff --git a/R/pip.R b/R/pip.R index c8d56e00..56d1e282 100644 --- a/R/pip.R +++ b/R/pip.R @@ -106,7 +106,6 @@ pip <- function(country = "ALL", aux_files = lkup$aux_files ) # lcv$est_ctrs has all the country_code that we are interested in - cache_file_path <- fs::path(lkup$data_root, 'cache', ext = "duckdb") if (!file.exists(cache_file_path)) { # Create an empty duckdb file diff --git a/R/rg_pip.R b/R/rg_pip.R index 5ff8552b..a491c8b3 100644 --- a/R/rg_pip.R +++ b/R/rg_pip.R @@ -17,7 +17,8 @@ rg_pip <- function(country, valid_regions <- lkup$query_controls$region$values svy_lkup <- lkup$svy_lkup data_dir <- lkup$data_root - + # povline is set to NULL if popshare is given + if (!is.null(popshare)) povline <- NULL cache_file_path <- fs::path(lkup$data_root, 'cache', ext = "duckdb") metadata <- subset_lkup( @@ -36,8 +37,6 @@ rg_pip <- function(country, data_present_in_master <- metadata$data_present_in_master povline <- metadata$povline metadata <- metadata$lkup - - # Remove aggregate distribution if popshare is specified # TEMPORARY FIX UNTIL popshare is supported for aggregate distributions metadata <- filter_lkup(metadata = metadata, @@ -51,12 +50,21 @@ rg_pip <- function(country, # load data lt <- load_data_list(metadata) - + # Calculate and update poverty line if popshare is passed + if (!is.null(popshare)) { + povline <- lapply(lt, \(x) wbpip:::md_infer_poverty_line(x$welfare, x$weight, popshare)) + } # parallelization # res <- get_pov_estimates(lt, povline = povline) - - # Regular lapply - res <- lapply(lt, process_dt, povline = povline) + # When poverty line is passed explicitly by user + if (length(povline) == 1) { + # Regular lapply + # passing povline[[1]] to pass povline as vector + res <- lapply(lt, process_dt, povline = povline[[1]]) + # When poverty line is calculated i.e popshare is passed + } else if (length(povline) == length(lt)) { + res <- Map(process_dt, lt, povline) + } res <- rbindlist(res, fill = TRUE) diff --git a/R/utils.R b/R/utils.R index ae4fdc89..02bc0a29 100644 --- a/R/utils.R +++ b/R/utils.R @@ -18,7 +18,22 @@ subset_lkup <- function(country, cache_file_path, fill_gaps ) { + lkup <- lkup_filter(lkup, country, year, valid_regions, reporting_level, welfare_type, data_dir) + # If povline is NULL, this happens when popshare is passed i.e popshare is not NULL + if (is.null(povline)) { + return(list(data_present_in_master = NULL, + lkup = lkup, + povline = NULL)) + } + # Return with grace + return_if_exists(slkup = lkup, + povline = povline, + cache_file_path = cache_file_path, + fill_gaps = fill_gaps) +} +#' @keywords internal +lkup_filter <- function(lkup, country, year, valid_regions, reporting_level, welfare_type, data_dir) { # STEP 1 - Keep every row by default keep <- rep(TRUE, nrow(lkup)) # STEP 2 - Select countries @@ -31,9 +46,6 @@ subset_lkup <- function(country, data_dir = data_dir, valid_regions = valid_regions) - # # step 4. Select MRV - # keep <- select_MRV(lkup, keep, year, country, valid_regions, data_dir) - # STEP 4 - Select welfare_type if (welfare_type[1] != "all") { keep <- keep & lkup$welfare_type == welfare_type @@ -45,14 +57,8 @@ subset_lkup <- function(country, lkup <- lkup[keep, ] - - # Return with grace - return_if_exists(slkup = lkup, - povline = povline, - cache_file_path = cache_file_path, - fill_gaps = fill_gaps) + return(lkup) } - #' select_country #' Helper function for subset_lkup() #' @inheritParams subset_lkup