update pip_pfw_key() and merger_aux() functions

NAMESPACE

@@ -2,13 +2,12 @@
 
 export("%>%")
 export(auto_aux_update)
-export(aux_data)
 export(cl_validate_raw)
 export(clean_validation_report)
+export(convert_df_to_base64)
 export(countries_validate_output)
 export(cpi_validate_output)
 export(cpi_validate_raw)
-export(convert_df_to_base64)
 export(draw_model)
 export(gdm_validate_output)
 export(gdm_validate_raw)
@@ -64,6 +63,7 @@ export(pop_validate_raw)
 export(popmain_validate_raw)
 export(ppp_validate_output)
 export(ppp_validate_raw)
+export(save_aux_to_gh)
 export(send_report)
 export(sna_fy_validate_raw)
 export(sna_validate_raw)

R/cpi_validate_output.R

@@ -30,10 +30,10 @@ cpi_validate_output <- function(cpi, detail = getOption("pipaux.detail.output"))
                 description = "`change_cpi2011` should be numeric") |>
     validate_cols(in_set(c(0, 1)), change_cpi2011,
                   description = "`change_cpi2011` values within range") |>
-    validate_if(is.character(cpi_domain),
-                description = "`cpi_domain` should be character") |>
-    validate_cols(in_set(c("National", "Urban/Rural")), cpi_domain,
-                  description = "`cpi_domian` values within range") |>
+    # validate_if(is.character(cpi_domain),
+    #             description = "`cpi_domain` should be character") |>
+    # validate_cols(in_set(c("National", "Urban/Rural")), cpi_domain,
+    #               description = "`cpi_domian` values within range") |>
     validate_if(is.numeric(cpi_domain_value),
                 description = "`cpi_domain_value` should be numeric") |>
     validate_cols(in_set(c(0, 1)), cpi_domain_value,

R/gdp_validate_output.R

@@ -24,10 +24,10 @@ gdp_validate_output <- function(gdp, detail = getOption("pipaux.detail.output"))
                   reporting_level, description = "`reporting_level` values within range") |>
     validate_if(is.numeric(gdp),
                 description = "`gdp` should be numeric") |>
-    validate_if(is.character(gdp_domain),
-                description = "`gdp_domain` should be character") |>
-    validate_cols(in_set(c("national", "urban/rural")),
-                  gdp_domain, description = "`gdp_domain` values within range") |>
+    # validate_if(is.character(gdp_domain),
+    #             description = "`gdp_domain` should be character") |>
+    # validate_cols(in_set(c("national", "urban/rural")),
+    #               gdp_domain, description = "`gdp_domain` values within range") |>
     validate_cols(not_na, country_code, year, reporting_level,
                   description = "no missing values in key variables") |>
     validate_if(is_uniq(country_code, year, reporting_level),

R/merger_aux.R

@@ -2,7 +2,8 @@
 #'
 #' @param aux_data1 auxiliary data one
 #' @param aux_data1 auxiliary data two
-#' @param keep merge/ join type, the default is left join, options (left, right, full, using, master, inner)
+#' @param merge_type merge/ join type, the default is left join, options (left, right, full, using, master, inner)
+#' @param commn_vars option to keep or retain common variables, default is TRUE
 #'
 #' @return data.table with key information
 #' @export
@@ -13,19 +14,19 @@
 #' pfw_ppp <- merger_aux(pfw, ppp)
 #'
 #' cpi <- load_aux("cpi")
-#' cpi <- cpi[, -c("cpi_domain")]
-#' pfw_cpi <- merger_aux(cpi, pfw, keep = "right")
+#' pfw_cpi <- merger_aux(cpi, pfw, merge_type = "right", commn_vars = FALSE)
 #' cpi_pfw <- merger_aux(cpi, pfw)
 #'
 merger_aux <- function(aux_data1,
                        aux_data2,
-                       keep = c("left", "right", "full",
+                       merge_type = c("left", "right", "full",
                                 "using", "master", "inner"),
+                       commn_vars = FALSE,
                        ...
 ){
 
-  keep  <- match.arg(keep)
-  print(keep)
+  merge_type  <- match.arg(merge_type)
+  print(merge_type)
 
   stopifnot("First data is empty" = !is.null(aux_data1))
   stopifnot("Second data is empty" = !is.null(aux_data2))
@@ -111,8 +112,8 @@ merger_aux <- function(aux_data1,
                       aux_data2,
                       by = int_key,
                       match_type = mtype,
-                      keep = keep)
-
+                      keep = merge_type,
+                      keep_common_vars = commn_vars)
 
   attr(mdata, "aux_key", union(attr(aux_data1, "aux_key"),
                                attr(aux_data2, "aux_key")))

R/pce_validate_output.R

@@ -24,10 +24,10 @@ pce_validate_output <- function(pce, detail = getOption("pipaux.detail.output"))
                 description = "`reporting_level` should be character") |>
     validate_cols(in_set(c("national", "rural", "urban")),
                   reporting_level, description = "`reporting_level` values within range") |>
-    validate_if(is.character(pce_domain),
-                description = "`pce_domain` should be character") |>
-    validate_cols(in_set(c("national", "urban/rural")),
-                  pce_domain, description = "`pce_domain` values within range") |>
+    # validate_if(is.character(pce_domain),
+    #             description = "`pce_domain` should be character") |>
+    # validate_cols(in_set(c("national", "urban/rural")),
+    #               pce_domain, description = "`pce_domain` values within range") |>
     validate_cols(not_na, country_code, year, reporting_level,
                   description = "no missing values in key variables") |>
     validate_if(is_uniq(country_code, year, reporting_level),

R/pip_aux_labels.R

@@ -9,19 +9,19 @@ pip_aux_labels <- function(x, measure) {
 
     # Label variables
     # attr(x$survey_year, "label") <- "Survey decimal year" #"Proportion of first year of survey"
-    attr(x$cpi_domain, "label") <- "CPI domain to join with microdata"
+    # attr(x$cpi_domain, "label") <- "CPI domain to join with microdata"
     # attr(x$cpi_data_level, "label") <- "Values to use as keys to join with cpi_domain_var"
-    attr(x$reporting, "label") <- "Values to use as keys to join with cpi_domain_var"
+    # attr(x$reporting, "label") <- "Values to use as keys to join with cpi_domain_var"
     # attr(x$cpi_year,  "label") <- "CPI year" #"Year of survey ID"
     attr(x$ccf, "label") <- "Currency conversion factor"
     attr(x$cpi, "label") <- "Consumer Price Index (Based on 2011)."
   } else if (measure == "ppp") {
     ppp_year <- unique(x[x$ppp_default == TRUE, "ppp_year"])
 
     # Label variables
-    attr(x$ppp_domain, "label") <- "PPP domain to join with microdata"
+    # attr(x$ppp_domain, "label") <- "PPP domain to join with microdata"
     # attr(x$ppp_data_level, "label") <- "Values to use as keys to join with ppp_domain_var"
-    attr(x$reporting, "label") <- "Values to use as keys to join with ppp_domain_var"
+    # attr(x$reporting, "label") <- "Values to use as keys to join with ppp_domain_var"
     attr(x$ppp, "label") <- paste0(
       "Purchasing Power Parity (",
       ppp_year, "2011 ICP round)"
@@ -46,23 +46,23 @@ pip_aux_labels <- function(x, measure) {
     attr(x$country_code, "label") <- "Country code"
     attr(x$year, "label") <- "Year"
     # attr(x$gdp_data_level, "label") <- "Values to use as keys to join with gdp_domain_var"
-    attr(x$reporting, "label") <- "Values to use as keys to join with gdp_domain_var"
+    # attr(x$reporting, "label") <- "Values to use as keys to join with gdp_domain_var"
     attr(x$gdp, "label") <- "GDP per capita (constant 2010 US$)"
-    attr(x$gdp_domain, "label") <- "GDP domain to join with microdata"
+    # attr(x$gdp_domain, "label") <- "GDP domain to join with microdata"
   } else if (measure == "pce") {
     attr(x$country_code, "label") <- "Country code"
     attr(x$year, "label") <- "Year"
     # attr(x$pce_data_level, "label") <- "Values to use as keys to join with \n pce_domain_var in microdata"
-    attr(x$reporting, "label") <- "Values to use as keys to join with \n pce_domain_var in microdata"
+    # attr(x$reporting, "label") <- "Values to use as keys to join with \n pce_domain_var in microdata"
     attr(x$pce, "label") <- "Households and NPISHs Final consumption expenditure per capita (constant 2010 US$)"
-    attr(x$pce_domain, "label") <- "PCE domain to join with microdata"
+    # attr(x$pce_domain, "label") <- "PCE domain to join with microdata"
   } else if (measure == "pop") {
     attr(x$country_code, "label") <- "Country code"
     attr(x$year, "label") <- "Year"
     # attr(x$pop_data_level, "label") <- "Values to use as keys to join with pop_domain_var"
-    attr(x$reporting, "label") <- "Values to use as keys to join with pop_domain_var"
+    # attr(x$reporting, "label") <- "Values to use as keys to join with pop_domain_var"
     attr(x$pop, "label") <- "Population"
-    attr(x$pop_domain, "label") <- "Population domain to join with microdata"
+    # attr(x$pop_domain, "label") <- "Population domain to join with microdata"
   } else {
     cli::cli_inform("no labels available for measure {.code {measure}}")
   }

R/pip_cpi_update.R

@@ -38,6 +38,9 @@ pip_cpi_update <- function(maindir = gls$PIP_DATA_DIR,
                        maindir = maindir,
                        branch = branch)
 
+  # drop cpi_domain
+  cpi <- cpi[, -c("cpi_domain")]
+
   # changae cpi_year and cpi_data_level to year and reporting_level
   cpi <- cpi |> setnames(c("cpi_year", "cpi_data_level"),
                          c("year", "reporting_level"),

R/pip_gdp_update.R

@@ -319,6 +319,9 @@ pip_gdp_update <- function(maindir = gls$PIP_DATA_DIR,
   # Remove any non-WDI countries
   gdp <- gdp[country_code %in% cl$country_code]
 
+  # drop gdp_domain
+  gdp <- gdp[, -c("gdp_domain")]
+
   # ---- Save and sign ----
   gdp <- gdp |> setnames("gdp_data_level", "reporting_level",
                          skip_absent=TRUE)

R/pip_pce_update.R

@@ -229,6 +229,9 @@ pip_pce_update <- function(maindir = gls$PIP_DATA_DIR,
 
   pce <- pce[country_code %in% cl$country_code]
 
+  # drop pce_domain
+  pce <- pce[, -c("pce_domain")]
+
   ## ---- Sign and save ----
   pce <- pce |> setnames("pce_data_level", "reporting_level",
                          skip_absent=TRUE)

R/pip_pfw_key.R

@@ -10,7 +10,6 @@ pip_pfw_key <- function(){
   pfw_key_options <- pfw_temp[, .(country_code,
                                   survey_year,
                                   survey_acronym,
-                                  welfare_type,
                                   cpi_domain_var)]
 
 

R/pip_pop_update.R

@@ -179,6 +179,10 @@ pip_pop_update <-  function(force   = FALSE,
   #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
   # Save data   ---------
   #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+  # drop pce_domain
+  pop <- pop[, -c("pop_domain")]
+
   pop <- pop |> setnames("pop_data_level", "reporting_level",
                          skip_absent=TRUE)
 

R/pip_ppp_update.R

@@ -62,6 +62,10 @@ pip_ppp_update <- function(maindir = gls$PIP_DATA_DIR,
 
 #   ____________________________________________________________________________
 #   Saving                                                                  ####
+
+  # drop ppp_domain
+  ppp <- ppp[, -c("ppp_domain")]
+
   ppp <- ppp |> setnames("ppp_data_level", "reporting_level",
                          skip_absent=TRUE)
 

R/pop_validate_output.R

@@ -24,10 +24,10 @@ pop_validate_output <- function(pop, detail = getOption("pipaux.detail.output"))
                   reporting_level, description = "`reporting_level` values within range") |>
     validate_if(is.numeric(pop),
                 description = "`pop` should be numeric") |>
-    validate_if(is.character(pop_domain),
-                description = "`pop_domain` should be character") |>
-    validate_cols(in_set(c("national", "urban/rural")),
-                  pop_domain, description = "`pop_domain` values within range") |>
+    # validate_if(is.character(pop_domain),
+    #             description = "`pop_domain` should be character") |>
+    # validate_cols(in_set(c("national", "urban/rural")),
+    #               pop_domain, description = "`pop_domain` values within range") |>
     validate_cols(not_na, country_code, year, reporting_level,
                   description = "no missing values in key variables") |>
     validate_if(is_uniq(country_code, year, reporting_level),

R/ppp_validate_output.R

@@ -28,10 +28,10 @@ ppp_validate_output <- function(ppp, detail = getOption("pipaux.detail.output"))
                 description = "`ppp_default` should be numeric") |>
     validate_if(is.logical(ppp_default_by_year),
                 description = "`ppp_default_by_year` should be numeric") |>
-    validate_if(is.character(ppp_domain),
-                description = "`ppp_domain` should be character") |>
-    validate_cols(in_set(c("1", "2")),
-                  ppp_domain, description = "`ppp_domain` values within range") |>
+    # validate_if(is.character(ppp_domain),
+    #             description = "`ppp_domain` should be character") |>
+    # validate_cols(in_set(c("1", "2")),
+    #               ppp_domain, description = "`ppp_domain` values within range") |>
     validate_if(is.character(reporting_level),
                 description = "`reporting_level` should be character") |>
     validate_cols(in_set(c("national", "rural", "urban")),