From 8fa5887a1f6f8f50e8859f19e5ad431d9e28a7a6 Mon Sep 17 00:00:00 2001 From: shahronak47 Date: Mon, 7 Jul 2025 22:50:52 +0530 Subject: [PATCH 1/3] draft to calculate povline --- R/pip.R | 10 ++++++++++ R/utils.R | 20 ++++++++++---------- 2 files changed, 20 insertions(+), 10 deletions(-) diff --git a/R/pip.R b/R/pip.R index c8d56e00..6969923a 100644 --- a/R/pip.R +++ b/R/pip.R @@ -107,6 +107,16 @@ pip <- function(country = "ALL", ) # lcv$est_ctrs has all the country_code that we are interested in + # Calculate and update poverty line if popshare is passed + if (!is.null(popshare)) { + # Filter only relevant data + lkup_metadata <- lkup_filter(lkup$svy_lkup, country, year, lkup$query_controls$region$values, + welfare_type, reporting_level, lkup$data_root) + lt <- load_data_list(lkup_metadata) |> + data.table::rbindlist(fill = TRUE) + povline <- wbpip:::md_infer_poverty_line(lt$welfare, lt$weight, popshare) + } + 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/utils.R b/R/utils.R index ae4fdc89..af5cda8b 100644 --- a/R/utils.R +++ b/R/utils.R @@ -18,7 +18,16 @@ subset_lkup <- function(country, cache_file_path, fill_gaps ) { + lkup <- lkup_filter(lkup, country, year, valid_regions, reporting_level, welfare_type, data_dir) + # 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 +40,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 +51,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 From f614e98602dbbd9374b899341c73fd755f2f20d9 Mon Sep 17 00:00:00 2001 From: shahronak47 Date: Thu, 10 Jul 2025 22:20:17 +0530 Subject: [PATCH 2/3] handle popshare value --- R/pip.R | 11 ----------- R/rg_pip.R | 22 +++++++++++++++------- R/utils.R | 6 ++++++ 3 files changed, 21 insertions(+), 18 deletions(-) diff --git a/R/pip.R b/R/pip.R index 6969923a..56d1e282 100644 --- a/R/pip.R +++ b/R/pip.R @@ -106,17 +106,6 @@ pip <- function(country = "ALL", aux_files = lkup$aux_files ) # lcv$est_ctrs has all the country_code that we are interested in - - # Calculate and update poverty line if popshare is passed - if (!is.null(popshare)) { - # Filter only relevant data - lkup_metadata <- lkup_filter(lkup$svy_lkup, country, year, lkup$query_controls$region$values, - welfare_type, reporting_level, lkup$data_root) - lt <- load_data_list(lkup_metadata) |> - data.table::rbindlist(fill = TRUE) - povline <- wbpip:::md_infer_poverty_line(lt$welfare, lt$weight, popshare) - } - 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..1a9b1dfa 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( @@ -32,12 +33,11 @@ rg_pip <- function(country, cache_file_path = cache_file_path, fill_gaps = FALSE ) + povline <- list(povline) 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 +51,20 @@ 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 + res <- lapply(lt, process_dt, povline = povline) + # 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 af5cda8b..02bc0a29 100644 --- a/R/utils.R +++ b/R/utils.R @@ -19,6 +19,12 @@ subset_lkup <- function(country, 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, From fabffea7ac3fe73cb04dd33d05432526eeda9c42 Mon Sep 17 00:00:00 2001 From: shahronak47 Date: Thu, 10 Jul 2025 22:42:13 +0530 Subject: [PATCH 3/3] handle povline of length 1 --- R/rg_pip.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/rg_pip.R b/R/rg_pip.R index 1a9b1dfa..a491c8b3 100644 --- a/R/rg_pip.R +++ b/R/rg_pip.R @@ -33,7 +33,6 @@ rg_pip <- function(country, cache_file_path = cache_file_path, fill_gaps = FALSE ) - povline <- list(povline) data_present_in_master <- metadata$data_present_in_master povline <- metadata$povline @@ -60,7 +59,8 @@ rg_pip <- function(country, # When poverty line is passed explicitly by user if (length(povline) == 1) { # Regular lapply - res <- lapply(lt, process_dt, povline = povline) + # 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)