Popshare fix

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

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)
 

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