separate function to handle missing function arguments

NEWS.md

@@ -7,6 +7,7 @@
 * Remove `purrr` dependency
 * add test for `sd_create_synth_vector`
 * create a separate function (`weighted_average_poverty_stats`) for repetitive calculation in adjust poverty stats and add corresponding test case for it. 
+* [create a separate function to handle missing arguments](https://github.com/PIP-Technical-Team/wbpip/issues/186)
 
 ## Bug fixes
 

R/gd_compute_pip_stats.R

@@ -84,3 +84,19 @@ gd_compute_pip_stats <- function(welfare,
 
   return(out)
 }
+
+
+#' Handle missing ppp values
+#'
+#' @inheritParams gd_compute_pip_stats
+#'
+#' @return A list of two numeric values (ppp and requested_mean)
+
+handle_missing_ppp <- function(ppp, requested_mean, default_ppp) {
+  if (!is.null(ppp)) {
+    requested_mean <- requested_mean * default_ppp / ppp
+  } else {
+    ppp <- default_ppp
+  }
+  return(list(ppp = ppp, requested_mean = requested_mean))
+}

R/gd_compute_pip_stats_lb.R

@@ -24,11 +24,7 @@ gd_compute_pip_stats_lb <- function(welfare,
                                     p0 = 0.5) {
 
   # Adjust mean if different PPP value is provided
-  if (!is.null(ppp)) {
-    requested_mean <- requested_mean * default_ppp / ppp
-  } else {
-    ppp <- default_ppp
-  }
+  adjusted_values <- handle_missing_ppp(ppp, requested_mean, default_ppp)
   # STEP 1: Prep data to fit functional form
   prepped_data <- create_functional_form_lb(
     welfare = welfare,
@@ -48,19 +44,19 @@ gd_compute_pip_stats_lb <- function(welfare,
   # instead of a poverty line
 
   if (!is.null(popshare)) {
-    povline <- derive_lb(popshare, A, B, C) * requested_mean
+    povline <- derive_lb(popshare, A, B, C) * adjusted_values$requested_mean
   }
 
   # Boundary conditions (Why 4?)
-  z_min <- requested_mean * derive_lb(0.001, A, B, C) + 4
-  z_max <- requested_mean * derive_lb(0.980, A, B, C) - 4
+  z_min <- adjusted_values$requested_mean * derive_lb(0.001, A, B, C) + 4
+  z_max <- adjusted_values$requested_mean * derive_lb(0.980, A, B, C) - 4
   z_min <- if (z_min < 0) 0L else z_min
 
-  results1 <- list(requested_mean, povline, z_min, z_max, ppp)
-  names(results1) <- list("mean", "poverty_line", "z_min", "z_max", "ppp")
+  results1 <- list(mean = adjusted_values$requested_mean, poverty_line = povline,
+                   z_min = z_min, z_max = z_max, ppp = adjusted_values$ppp)
 
   # STEP 3: Estimate poverty measures based on identified parameters
-  results2 <- gd_estimate_lb(requested_mean, povline, p0, A, B, C)
+  results2 <- gd_estimate_lb(adjusted_values$requested_mean, povline, p0, A, B, C)
 
   # STEP 4: Compute measure of regression fit
   results_fit <- gd_compute_fit_lb(welfare, population, results2$headcount, A, B, C)

R/gd_compute_pip_stats_lq.R

@@ -47,11 +47,7 @@ gd_compute_pip_stats_lq <- function(welfare,
                                     p0 = 0.5) {
 
   # Adjust mean if different PPP value is provided
-  if (!is.null(ppp)) {
-    requested_mean <- requested_mean * default_ppp / ppp
-  } else {
-    ppp <- default_ppp
-  }
+  adjusted_values <- handle_missing_ppp(ppp, requested_mean, default_ppp)
   # STEP 1: Prep data to fit functional form
   prepped_data <- create_functional_form_lq(
     welfare = welfare,
@@ -70,19 +66,19 @@ gd_compute_pip_stats_lq <- function(welfare,
   # return poverty line if share of population living in poverty is supplied
   # intead of a poverty line
   if (!is.null(popshare)) {
-    povline <- derive_lq(popshare, A, B, C) * requested_mean
+    povline <- derive_lq(popshare, A, B, C) * adjusted_values$requested_mean
   }
 
   # Boundary conditions (Why 4?)
-  z_min <- requested_mean * derive_lq(0.001, A, B, C) + 4
-  z_max <- requested_mean * derive_lq(0.980, A, B, C) - 4
+  z_min <- adjusted_values$requested_mean * derive_lq(0.001, A, B, C) + 4
+  z_max <- adjusted_values$requested_mean * derive_lq(0.980, A, B, C) - 4
   z_min <- if (z_min < 0) 0L else z_min
 
-  results1 <- list(requested_mean, povline, z_min, z_max, ppp)
-  names(results1) <- list("mean", "poverty_line", "z_min", "z_max", "ppp")
+  results1 <- list(mean = adjusted_values$requested_mean, poverty_line = povline,
+                   z_min = z_min, z_max = z_max, ppp = adjusted_values$ppp)
 
   # STEP 3: Estimate poverty measures based on identified parameters
-  results2 <- gd_estimate_lq(requested_mean, povline, p0, A, B, C)
+  results2 <- gd_estimate_lq(adjusted_values$requested_mean, povline, p0, A, B, C)
 
   # STEP 4: Compute measure of regression fit
   results_fit <- gd_compute_fit_lq(welfare, population, results2$headcount, A, B, C)

R/gd_compute_poverty_stats.R

@@ -28,11 +28,7 @@ gd_compute_poverty_stats <- function(welfare,
 
   # Apply Lorenz quadratic fit ----------------------------------------------
   # Adjust mean if different PPP value is provided
-  if (!is.null(ppp)) {
-    requested_mean <- requested_mean * default_ppp / ppp
-  } else {
-    ppp <- default_ppp
-  }
+  adjusted_values <- handle_missing_ppp(ppp, requested_mean, default_ppp)
   # STEP 1: Prep data to fit functional form
   prepped_data <- create_functional_form_lq(
     welfare = welfare,
@@ -45,7 +41,7 @@ gd_compute_poverty_stats <- function(welfare,
 
   # STEP 3: Calculate poverty stats
   results_lq <- gd_estimate_poverty_stats_lq(
-    mean = requested_mean,
+    mean = adjusted_values$requested_mean,
     povline = povline,
     A = reg_coef_lq[1],
     B = reg_coef_lq[2],
@@ -77,7 +73,7 @@ gd_compute_poverty_stats <- function(welfare,
 
   # STEP 3: Calculate distributional stats
   results_lb <- gd_estimate_poverty_stats_lb(
-    mean = requested_mean,
+    mean = adjusted_values$requested_mean,
     povline = povline,
     A = reg_coef_lb[1],
     B = reg_coef_lb[2],

tests/testthat/test-gd_compute_pip_stats.R

@@ -57,3 +57,18 @@ test_that("retrieve_distributional() returns correct results", {
     expected
   )
 })
+
+
+test_that("handle_missing_ppp() returns correct results", {
+  res1 <- handle_missing_ppp(2.15, 10, 1.2)
+
+  expect_length(res1, 2)
+  expect_equal(res1$ppp, 2.15)
+  expect_equal(res1$requested_mean, 5.581395, tolerance = 0.001)
+
+  res2 <- handle_missing_ppp(NULL, 10, 1.2)
+
+  expect_length(res2, 2)
+  expect_equal(res2$ppp, 1.2)
+  expect_equal(res2$requested_mean, 10)
+})