From df8cc67e6d01c69a87eef3606807f709daac61ae Mon Sep 17 00:00:00 2001
From: giorgiacek <giorgivola@gmail.com>
Date: Fri, 22 Mar 2024 12:38:26 -0400
Subject: [PATCH 1/4] pov_headcount adjusted

---
 R/pipgd_pov.R | 29 +++++++++++++++++++++++++----
 1 file changed, 25 insertions(+), 4 deletions(-)

diff --git a/R/pipgd_pov.R b/R/pipgd_pov.R
index fe034e9..16f096b 100644
--- a/R/pipgd_pov.R
+++ b/R/pipgd_pov.R
@@ -28,6 +28,16 @@ pipgd_pov_headcount_nv <-
   pl <- as.list(environment())
   check_pipgd_params(pl)
   po <- is_valid_inputs_pov(pl)
+  print(po)
+
+  # Preserve the original lorenz if pipster_object exists and lorenz is not provided
+  original_lorenz <- if (is.null(lorenz) && !is.null(pipster_object) && !is.null(pipster_object$args$lorenz)) {
+    pipster_object$args$lorenz
+  } else {
+    lorenz
+  }
+
+  print(original_lorenz)
 
   # __________________________________________________________________________
   # params--------------------------------------------------------------------
@@ -40,19 +50,30 @@ pipgd_pov_headcount_nv <-
                                       mean           = mean,
                                       times_mean     = times_mean,
                                       povshare       = povshare,
-                                      lorenz         = lorenz,
+                                      lorenz         = original_lorenz,
                                       povline        = povline)
     params <- pipster_object$params
   }
 
   # Lorenz----------------------------------------------------------------------
   #_____________________________________________________________________________
-  if (is.null(lorenz)) {
-    lorenz <- params$selected_lorenz$for_pov
+
+  # If lorenz is explicitly specified in the function call, use it
+  if (!is.null(lorenz)) {
+    lorenz <- match.arg(lorenz, c("lq", "lb"))
   } else {
-    match.arg(lorenz, c("lq", "lb"))
+    # If lorenz is specified in pipster_object and not overridden by the function call, use it
+    if (!is.null(pipster_object$args$lorenz)) {
+      lorenz <- pipster_object$args$lorenz
+    } else {
+      # Use the selected lorenz if not specified in the function call or pipster_object
+      lorenz <- params$selected_lorenz$for_pov
+    }
   }
 
+  # Headcount ------------------------------------------------------------------
+  # ____________________________________________________________________________
+
   headcount <- params$gd_params[[lorenz]]$validity$headcount
 
   # Return----------------------------------------------------------------------

From 0a184d89d3d5e4819bae5bbf805a4200cf8840ad Mon Sep 17 00:00:00 2001
From: giorgiacek <giorgivola@gmail.com>
Date: Fri, 22 Mar 2024 12:43:00 -0400
Subject: [PATCH 2/4] other pov measures adjusted

---
 R/pipgd_pov.R | 49 +++++++++++++++++++++++++++++++++++--------------
 1 file changed, 35 insertions(+), 14 deletions(-)

diff --git a/R/pipgd_pov.R b/R/pipgd_pov.R
index 16f096b..cab311d 100644
--- a/R/pipgd_pov.R
+++ b/R/pipgd_pov.R
@@ -28,7 +28,6 @@ pipgd_pov_headcount_nv <-
   pl <- as.list(environment())
   check_pipgd_params(pl)
   po <- is_valid_inputs_pov(pl)
-  print(po)
 
   # Preserve the original lorenz if pipster_object exists and lorenz is not provided
   original_lorenz <- if (is.null(lorenz) && !is.null(pipster_object) && !is.null(pipster_object$args$lorenz)) {
@@ -37,8 +36,6 @@ pipgd_pov_headcount_nv <-
     lorenz
   }
 
-  print(original_lorenz)
-
   # __________________________________________________________________________
   # params--------------------------------------------------------------------
   if (po) {
@@ -231,10 +228,18 @@ pipgd_pov_gap_nv <- function(pipster_object = NULL,
 
   # Lorenz----------------------------------------------------------------------
   #_____________________________________________________________________________
-  if (is.null(lorenz)) {
-    lorenz <- params$selected_lorenz$for_pov
+
+  # If lorenz is explicitly specified in the function call, use it
+  if (!is.null(lorenz)) {
+    lorenz <- match.arg(lorenz, c("lq", "lb"))
   } else {
-    match.arg(lorenz, c("lq", "lb"))
+    # If lorenz is specified in pipster_object and not overridden by the function call, use it
+    if (!is.null(pipster_object$args$lorenz)) {
+      lorenz <- pipster_object$args$lorenz
+    } else {
+      # Use the selected lorenz if not specified in the function call or pipster_object
+      lorenz <- params$selected_lorenz$for_pov
+    }
   }
 
   # povline---------------------------------------------------------------------
@@ -426,12 +431,20 @@ pipgd_pov_severity_nv <- function(
 
   check_pipgd_params(pl)
 
-  # __________________________________________________________________________
-  # Lorenz -------------------------------------------------------------------
-  if (is.null(lorenz)) {
-    lorenz <- params$selected_lorenz$for_pov
+  # Lorenz----------------------------------------------------------------------
+  #_____________________________________________________________________________
+
+  # If lorenz is explicitly specified in the function call, use it
+  if (!is.null(lorenz)) {
+    lorenz <- match.arg(lorenz, c("lq", "lb"))
   } else {
-    match.arg(lorenz, c("lq", "lb"))
+    # If lorenz is specified in pipster_object and not overridden by the function call, use it
+    if (!is.null(pipster_object$args$lorenz)) {
+      lorenz <- pipster_object$args$lorenz
+    } else {
+      # Use the selected lorenz if not specified in the function call or pipster_object
+      lorenz <- params$selected_lorenz$for_pov
+    }
   }
 
   # povline-------------------------------------------------------------------
@@ -661,10 +674,18 @@ pipgd_watts_nv <- function(
 
   # Lorenz----------------------------------------------------------------------
   #_____________________________________________________________________________
-  if (is.null(lorenz)) {
-    lorenz <- params$selected_lorenz$for_pov
+
+  # If lorenz is explicitly specified in the function call, use it
+  if (!is.null(lorenz)) {
+    lorenz <- match.arg(lorenz, c("lq", "lb"))
   } else {
-    match.arg(lorenz, c("lq", "lb"))
+    # If lorenz is specified in pipster_object and not overridden by the function call, use it
+    if (!is.null(pipster_object$args$lorenz)) {
+      lorenz <- pipster_object$args$lorenz
+    } else {
+      # Use the selected lorenz if not specified in the function call or pipster_object
+      lorenz <- params$selected_lorenz$for_pov
+    }
   }
 
   # povline---------------------------------------------------------------------

From c4f37d9989ba877664afec7a7c14955774b48074 Mon Sep 17 00:00:00 2001
From: giorgiacek <giorgivola@gmail.com>
Date: Fri, 22 Mar 2024 13:31:44 -0400
Subject: [PATCH 3/4] tests for lorenz in pipgd_pov functions

---
 tests/testthat/test-pipgd_pov.R | 167 +++++++++++++++++++++++++++++++-
 1 file changed, 165 insertions(+), 2 deletions(-)

diff --git a/tests/testthat/test-pipgd_pov.R b/tests/testthat/test-pipgd_pov.R
index 4c0681c..25a80c4 100644
--- a/tests/testthat/test-pipgd_pov.R
+++ b/tests/testthat/test-pipgd_pov.R
@@ -237,8 +237,6 @@ test_that("pipgd_pov_headcount works as expected", {
                           lorenz  = "lq")$headcount))
 })
 
-# Test poverty gap functions ####
-# Test pipgd_pov_gap_nv (non vectorized function)
 
 #_______________________________________________________________________________
 # POV GAP ----------------------------------------------------------------------
@@ -1246,3 +1244,168 @@ test_that("validate_params is equiv for all input types", {
 })
 
 
+#_______________________________________________________________________________
+# LORENZ CHECKS -----------------------------------------------------------------
+#_______________________________________________________________________________
+# Set-up
+
+pipster_object_with_lq <- create_pipster_object(welfare = pip_gd$L,
+                                                weight  = pip_gd$P,
+                                                lorenz = 'lq')
+
+pipster_object_with_lb <- create_pipster_object(welfare = pip_gd$L,
+                                                weight  = pip_gd$P,
+                                                lorenz = 'lb')
+
+pipster_object_without <- create_pipster_object(welfare = pip_gd$L,
+                                                weight  = pip_gd$P)
+
+# Tests
+## pipgd_headcount
+test_that("pipgd_headcount uses right lorenz", {
+
+  # unspecified
+  without <- pipgd_pov_headcount(pipster_object_without)
+  expect_equal(without$lorenz,
+               pipster_object_without$params$selected_lorenz$for_pov)
+
+  with_lb <- pipgd_pov_headcount(pipster_object_with_lb)
+  expect_equal(with_lb$lorenz,
+               pipster_object_with_lb$args$lorenz)
+
+  with_lq <- pipgd_pov_headcount(pipster_object_with_lq)
+  expect_equal(with_lq$lorenz,
+               pipster_object_with_lq$args$lorenz)
+
+  # specified lb
+  without <- pipgd_pov_headcount(pipster_object_without, lorenz = 'lb')
+  expect_equal(without$lorenz, "lb")
+
+  with_lb <- pipgd_pov_headcount(pipster_object_with_lb, lorenz = 'lb')
+  expect_equal(with_lb$lorenz, "lb")
+
+  with_lq <- pipgd_pov_headcount(pipster_object_with_lq, lorenz = 'lb')
+  expect_equal(with_lq$lorenz, 'lb')
+
+  # specified lq
+  without <- pipgd_pov_headcount(pipster_object_without, lorenz = 'lq')
+  expect_equal(without$lorenz, "lq")
+
+  with_lb <- pipgd_pov_headcount(pipster_object_with_lb, lorenz = 'lq')
+  expect_equal(with_lb$lorenz, "lq")
+
+  with_lq <- pipgd_pov_headcount(pipster_object_with_lq, lorenz = 'lq')
+  expect_equal(with_lq$lorenz, 'lq')
+
+})
+
+## pipgd_pov_gap
+
+test_that("pipgd_pov_gap uses right lorenz", {
+
+  # unspecified
+  without <- pipgd_pov_gap(pipster_object_without)
+  expect_equal(without$lorenz,
+               pipster_object_without$params$selected_lorenz$for_pov)
+
+  with_lb <- pipgd_pov_gap(pipster_object_with_lb)
+  expect_equal(with_lb$lorenz,
+               pipster_object_with_lb$args$lorenz)
+
+  with_lq <- pipgd_pov_gap(pipster_object_with_lq)
+  expect_equal(with_lq$lorenz,
+               pipster_object_with_lq$args$lorenz)
+
+  # specified lb
+  without <- pipgd_pov_gap(pipster_object_without, lorenz = 'lb')
+  expect_equal(without$lorenz, "lb")
+
+  with_lb <- pipgd_pov_gap(pipster_object_with_lb, lorenz = 'lb')
+  expect_equal(with_lb$lorenz, "lb")
+
+  with_lq <- pipgd_pov_gap(pipster_object_with_lq, lorenz = 'lb')
+  expect_equal(with_lq$lorenz, 'lb')
+
+  # specified lq
+  without <- pipgd_pov_gap(pipster_object_without, lorenz = 'lq')
+  expect_equal(without$lorenz, "lq")
+
+  with_lb <- pipgd_pov_gap(pipster_object_with_lb, lorenz = 'lq')
+  expect_equal(with_lb$lorenz, "lq")
+
+  with_lq <- pipgd_pov_gap(pipster_object_with_lq, lorenz = 'lq')
+  expect_equal(with_lq$lorenz, 'lq')
+
+})
+
+## pipgd_pov_severity
+test_that("pipgd_severity uses right lorenz", {
+
+  # unspecified lorenz
+  without <- pipgd_pov_severity(pipster_object_without)
+  expect_equal(without$lorenz, pipster_object_without$params$selected_lorenz$for_pov)
+
+  with_lb <- pipgd_pov_severity(pipster_object_with_lb)
+  expect_equal(with_lb$lorenz, pipster_object_with_lb$args$lorenz)
+
+  with_lq <- pipgd_pov_severity(pipster_object_with_lq)
+  expect_equal(with_lq$lorenz, pipster_object_with_lq$args$lorenz)
+
+  # specified lorenz as 'lb'
+  without <- pipgd_pov_severity(pipster_object_without, lorenz = 'lb')
+  expect_equal(without$lorenz, "lb")
+
+  with_lb <- pipgd_pov_severity(pipster_object_with_lb, lorenz = 'lb')
+  expect_equal(with_lb$lorenz, "lb")
+
+  with_lq <- pipgd_pov_severity(pipster_object_with_lq, lorenz = 'lb')
+  expect_equal(with_lq$lorenz, 'lb')
+
+  # specified lorenz as 'lq'
+  without <- pipgd_pov_severity(pipster_object_without, lorenz = 'lq')
+  expect_equal(without$lorenz, "lq")
+
+  with_lb <- pipgd_pov_severity(pipster_object_with_lb, lorenz = 'lq')
+  expect_equal(with_lb$lorenz, "lq")
+
+  with_lq <- pipgd_pov_severity(pipster_object_with_lq, lorenz = 'lq')
+  expect_equal(with_lq$lorenz, 'lq')
+
+})
+
+
+## pipgd_watts
+test_that("pipgd_watts uses right lorenz", {
+
+  # unspecified lorenz
+  without <- pipgd_watts(pipster_object_without)
+  expect_equal(without$lorenz, pipster_object_without$params$selected_lorenz$for_pov)
+
+  with_lb <- pipgd_watts(pipster_object_with_lb)
+  expect_equal(with_lb$lorenz, pipster_object_with_lb$args$lorenz)
+
+  with_lq <- pipgd_watts(pipster_object_with_lq)
+  expect_equal(with_lq$lorenz, pipster_object_with_lq$args$lorenz)
+
+  # specified lorenz as 'lb'
+  without <- pipgd_watts(pipster_object_without, lorenz = 'lb')
+  expect_equal(without$lorenz, "lb")
+
+  with_lb <- pipgd_watts(pipster_object_with_lb, lorenz = 'lb')
+  expect_equal(with_lb$lorenz, "lb")
+
+  with_lq <- pipgd_watts(pipster_object_with_lq, lorenz = 'lb')
+  expect_equal(with_lq$lorenz, 'lb')
+
+  # specified lorenz as 'lq'
+  without <- pipgd_watts(pipster_object_without, lorenz = 'lq')
+  expect_equal(without$lorenz, "lq")
+
+  with_lb <- pipgd_watts(pipster_object_with_lb, lorenz = 'lq')
+  expect_equal(with_lb$lorenz, "lq")
+
+  with_lq <- pipgd_watts(pipster_object_with_lq, lorenz = 'lq')
+  expect_equal(with_lq$lorenz, 'lq')
+
+})
+

From 87665698a071bba6e0142494fbac8f924ad074b3 Mon Sep 17 00:00:00 2001
From: giorgiacek <giorgivola@gmail.com>
Date: Fri, 22 Mar 2024 15:14:33 -0400
Subject: [PATCH 4/4] wrapper for lorenz check

---
 R/pipgd_pov.R | 79 +++++++++++++++++++--------------------------------
 1 file changed, 30 insertions(+), 49 deletions(-)

diff --git a/R/pipgd_pov.R b/R/pipgd_pov.R
index cab311d..c769638 100644
--- a/R/pipgd_pov.R
+++ b/R/pipgd_pov.R
@@ -55,18 +55,9 @@ pipgd_pov_headcount_nv <-
   # Lorenz----------------------------------------------------------------------
   #_____________________________________________________________________________
 
-  # If lorenz is explicitly specified in the function call, use it
-  if (!is.null(lorenz)) {
-    lorenz <- match.arg(lorenz, c("lq", "lb"))
-  } else {
-    # If lorenz is specified in pipster_object and not overridden by the function call, use it
-    if (!is.null(pipster_object$args$lorenz)) {
-      lorenz <- pipster_object$args$lorenz
-    } else {
-      # Use the selected lorenz if not specified in the function call or pipster_object
-      lorenz <- params$selected_lorenz$for_pov
-    }
-  }
+  lorenz <- choose_lorenz_for_pov(pipster_object,
+                                  params,
+                                  lorenz)
 
   # Headcount ------------------------------------------------------------------
   # ____________________________________________________________________________
@@ -229,18 +220,9 @@ pipgd_pov_gap_nv <- function(pipster_object = NULL,
   # Lorenz----------------------------------------------------------------------
   #_____________________________________________________________________________
 
-  # If lorenz is explicitly specified in the function call, use it
-  if (!is.null(lorenz)) {
-    lorenz <- match.arg(lorenz, c("lq", "lb"))
-  } else {
-    # If lorenz is specified in pipster_object and not overridden by the function call, use it
-    if (!is.null(pipster_object$args$lorenz)) {
-      lorenz <- pipster_object$args$lorenz
-    } else {
-      # Use the selected lorenz if not specified in the function call or pipster_object
-      lorenz <- params$selected_lorenz$for_pov
-    }
-  }
+  lorenz <- choose_lorenz_for_pov(pipster_object,
+                                  params,
+                                  lorenz)
 
   # povline---------------------------------------------------------------------
   #_____________________________________________________________________________
@@ -434,18 +416,9 @@ pipgd_pov_severity_nv <- function(
   # Lorenz----------------------------------------------------------------------
   #_____________________________________________________________________________
 
-  # If lorenz is explicitly specified in the function call, use it
-  if (!is.null(lorenz)) {
-    lorenz <- match.arg(lorenz, c("lq", "lb"))
-  } else {
-    # If lorenz is specified in pipster_object and not overridden by the function call, use it
-    if (!is.null(pipster_object$args$lorenz)) {
-      lorenz <- pipster_object$args$lorenz
-    } else {
-      # Use the selected lorenz if not specified in the function call or pipster_object
-      lorenz <- params$selected_lorenz$for_pov
-    }
-  }
+  lorenz <- choose_lorenz_for_pov(pipster_object,
+                                  params,
+                                  lorenz)
 
   # povline-------------------------------------------------------------------
   #___________________________________________________________________________
@@ -675,18 +648,9 @@ pipgd_watts_nv <- function(
   # Lorenz----------------------------------------------------------------------
   #_____________________________________________________________________________
 
-  # If lorenz is explicitly specified in the function call, use it
-  if (!is.null(lorenz)) {
-    lorenz <- match.arg(lorenz, c("lq", "lb"))
-  } else {
-    # If lorenz is specified in pipster_object and not overridden by the function call, use it
-    if (!is.null(pipster_object$args$lorenz)) {
-      lorenz <- pipster_object$args$lorenz
-    } else {
-      # Use the selected lorenz if not specified in the function call or pipster_object
-      lorenz <- params$selected_lorenz$for_pov
-    }
-  }
+  lorenz <- choose_lorenz_for_pov(pipster_object,
+                                  params,
+                                  lorenz)
 
   # povline---------------------------------------------------------------------
   #_____________________________________________________________________________
@@ -839,7 +803,7 @@ pipgd_watts <- function(
 }
 
 
-
+# WRAPPERS -------
 
 #' Validate group data parameters
 #'
@@ -933,6 +897,23 @@ is_valid_inputs_pov <- function(pl) {
   }
 }
 
+choose_lorenz_for_pov <- function(pipster_object = NULL,
+                                  params = NULL,
+                                  lorenz = NULL) {
+  if (!is.null(lorenz)) {
+    chosen_lorenz <- match.arg(lorenz, c("lq", "lb"))
+  } else {
+    # If lorenz is specified in pipster_object and not overridden by the function call, use it
+    if (!is.null(pipster_object$args$lorenz)) {
+      chosen_lorenz <- pipster_object$args$lorenz
+    } else {
+      # Use the selected lorenz if not specified in the function call or pipster_object
+      chosen_lorenz <- params$selected_lorenz$for_pov
+    }
+  }
+
+  return(chosen_lorenz)
+}