Merge pull request #12 from PIP-Technical-Team/pipster_functions

Pipster functions (md_functions and gd_functions)

.Rbuildignore

@@ -7,3 +7,4 @@
 ^docs$
 ^pkgdown$
 ^\.github$
+^codecov\.yml$

.github/workflows/pkgdown.yaml

@@ -2,9 +2,9 @@
 # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help
 on:
   push:
-    branches: [main, master]
+    branches: [main, master, DEV_website]
   pull_request:
-    branches: [main, master]
+    branches: [main, master, DEV_website]
   release:
     types: [published]
   workflow_dispatch:

.github/workflows/test-coverage.yaml

@@ -0,0 +1,50 @@
+# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples
+# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help
+on:
+  push:
+    branches: [main, master]
+  pull_request:
+    branches: [main, master]
+
+name: test-coverage
+
+jobs:
+  test-coverage:
+    runs-on: ubuntu-latest
+    env:
+      GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
+
+    steps:
+      - uses: actions/checkout@v3
+
+      - uses: r-lib/actions/setup-r@v2
+        with:
+          use-public-rspm: true
+
+      - uses: r-lib/actions/setup-r-dependencies@v2
+        with:
+          extra-packages: any::covr
+          needs: coverage
+
+      - name: Test coverage
+        run: |
+          covr::codecov(
+            quiet = FALSE,
+            clean = FALSE,
+            install_path = file.path(normalizePath(Sys.getenv("RUNNER_TEMP"), winslash = "/"), "package")
+          )
+        shell: Rscript {0}
+
+      - name: Show testthat output
+        if: always()
+        run: |
+          ## --------------------------------------------------------------------
+          find ${{ runner.temp }}/package -name 'testthat.Rout*' -exec cat '{}' \; || true
+        shell: bash
+
+      - name: Upload test results
+        if: failure()
+        uses: actions/upload-artifact@v3
+        with:
+          name: coverage-test-failures
+          path: ${{ runner.temp }}/package

.gitignore

@@ -3,3 +3,4 @@
 .RData
 .Ruserdata
 docs
+inst/doc

DESCRIPTION

@@ -1,28 +1,38 @@
 Package: pipster
 Title: What the Package Does (One Line, Title Case)
-Version: 0.0.0.9002
+Version: 0.0.1
 Authors@R: c(
     person(
       "R.Andres", "Castaneda",
       email = "[email protected]",
       role = c("aut", "cre")
-      ))
+      ),
+      person(given = "Zander",
+            family = "Prinsloo",
+            role = "aut",
+            email = "[email protected]")
+            )
 Description: What the package does (one paragraph).
 License: MIT + file LICENSE
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.1
 Suggests: 
+    knitr,
+    rmarkdown,
     testthat (>= 3.0.0),
     tibble,
     withr
 Config/testthat/edition: 3
 Imports: 
     cli,
-    collapse,
+    collapse (>= 2.0.9),
     data.table,
-    wbpip (>= 0.1.0.9002)
+    wbpip (>= 0.1.0.9012)
 Depends: 
     R (>= 2.10)
 LazyData: true
 URL: https://pip-technical-team.github.io/pipster/
+Remotes: 
+    github::PIP-Technical-Team/wbpip@dev_stage2
+VignetteBuilder: knitr

NAMESPACE

@@ -2,12 +2,27 @@
 
 export(as_pip)
 export(identify_pip_type)
+export(pipgd_gini)
+export(pipgd_lorenz_curve)
+export(pipgd_mld)
 export(pipgd_params)
 export(pipgd_pov_gap)
 export(pipgd_pov_headcount)
+export(pipgd_pov_severity)
 export(pipgd_quantile)
 export(pipgd_quantile_welfare_share)
 export(pipgd_select_lorenz)
 export(pipgd_validate_lorenz)
+export(pipgd_watts)
 export(pipgd_welfare_share_at)
+export(pipmd_gini)
+export(pipmd_mld)
+export(pipmd_polarization)
+export(pipmd_pov_gap)
+export(pipmd_pov_headcount)
+export(pipmd_pov_severity)
+export(pipmd_quantile)
+export(pipmd_quantile_welfare_share)
+export(pipmd_watts)
+export(pipmd_welfare_share_at)
 import(collapse)

R/as_pip.R

@@ -17,10 +17,26 @@
 #' @export
 #'
 #' @examples
+#' # Example 1: Basic usage with md data.
 #' as_pip(dt = pip_md,
-#' welfare_var = "welfare",
-#' weight_var = "weight") |>
+#'        welfare_var = "welfare",
+#'        weight_var = "weight") |>
 #' class()
+#'
+#' # Example 2: Including imputation_id_var
+#' as_pip(dt = pip_id,
+#'        welfare_var = "welfare",
+#'        weight_var = "weight",
+#'        imputation_id_var = "imputation_id") |>
+#' class()
+#'
+#' # Example 3: Basic usage with gd data and explicit pip_type
+#' as_pip(dt = pip_gd,
+#'        welfare_var = "L",
+#'        weight_var = "P",
+#'        pip_type = "gd_1") |>
+#' class()
+#'
 as_pip <- function(
     dt,
     welfare_var,
@@ -56,10 +72,11 @@ as_pip <- function(
   } else {
     identify_pip_type_check()
   }
-  pip_type <- match.arg(pip_type, c("md", "id", "gd_1", "gd_2", "gd_3", "gd_4", "gd_5"))
 
+  pip_type <- match.arg(pip_type, c("md", "id", "gd_1", "gd_2", "gd_3", "gd_4", "gd_5"))
   convert_to_pip_format_check()
 
+
   #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
   # set up   ---------
   #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -90,7 +107,7 @@ as_pip <- function(
     tp <- gsub("(gd_)([1-5])", "\\2", pip_type) |>
       as.numeric()
 
-    wbpip:::gd_clean_data(dt = dt,
+    wbpip::gd_clean_data(dt = dt,
                                 welfare = welfare_var,
                                 population = weight_var,
                                 gd_type = tp)
@@ -153,10 +170,10 @@ convert_to_pip_format_check <- function() {
 
   #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
   ## Defenses --------
-  stopifnot( exprs = {
-
-  }
-  )
+  # stopifnot( exprs = {
+  #
+  # }
+  # )
 
   #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
   ## Warnings --------

R/check_params.R

@@ -0,0 +1,159 @@
+#' Check parameters of pipgd functions
+#'
+#' @param lp list of parameters
+#'
+#' @return invisible TRUE
+#' @keywords internal
+check_pipgd_params <- function(lp) {
+
+  #   ____________________________________________________________________________
+  #   Computations                                                            ####
+
+  nlp <- names(lp)
+
+  ## params --------------------
+  if ("params" %in% nlp) {
+    if (!is.null(lp$params) && !inherits(lp$params, "pipgd_params")) {
+      cli::cli_abort(c("argument {.field params} must be of
+                       class {.code pipgd_params}.",
+                       "It should be created using {.fun pipgd_params}"))
+    }
+  }
+
+  ## welfare -----------
+
+
+  ## welfare and params -----------
+  if ( all(c("params", "welfare") %in% nlp)) {
+    if (!is.null(lp$params) &&
+        (!is.null(lp$welfare)  || !is.null(lp$population))) {
+      cli::cli_abort("You must specify either {.field params} or
+                {.field welfare} and {.field population}")
+    }
+  }
+
+
+  ## povline and popshare ----------
+  if ( all(c("povline", "popshare") %in% nlp)) {
+    if (!is.na(lp$povline) && !is.null(lp$popshare)) {
+      cli::cli_abort("You must specify either {.field povline} or
+                {.field popshare}")
+    }
+  }
+
+  if ("popshare" %in% nlp) {
+    if (any(lp$popshare <= 0)) {
+      cli::cli_abort("All values in {.arg popshare} must be positve")
+    }
+  }
+
+  if ("popshare" %in% nlp) {
+    if (any(lp$popshare > 1)) {
+      cli::cli_abort("No values in {.arg popshare} can be >1")
+    }
+  }
+
+
+  # "Either `params` or `welfare` and `population` should be spefied" =
+  #   (is.null(params) && !is.null(welfare) && !is.null(population)) ||
+  #   (!is.null(params) && is.null(welfare) && is.null(population))
+  #
+  # "`params` should be a list from `pipgd_validate_lorenz()`" =
+  #   is.list(params) || is.null(params)
+  #
+  # "`complete` must be logical" =
+  #   is.logical(complete)
+
+  ## lorenz -----------
+  if ( all(c("lorenz") %in% nlp)) {
+
+    if (!is.null(lp$lorenz) && !lp$lorenz %in% c("lq", "lb")) {
+
+      cli::cli_abort("{.field lorenz} must be either 'lq' or 'lb', or
+                {.code NULL} to let the algorithm select")
+    }
+  }
+
+
+  #   ____________________________________________________________________________
+  #   Return                                                                  ####
+  return(invisible(TRUE))
+
+}
+
+
+#' Check parameters of pipmd functions
+#'
+#'
+#' @return invisible TRUE
+#' @keywords internal
+check_pipmd_pov <- function() {
+  lp <- parent.frame()  |>
+    as.list()
+
+  with(lp, {
+    if (is.na(welfare) |> any()) {
+      cli::cli_abort("No elements in welfare vector can be NA")
+    }
+    if (!is.numeric(welfare)) {
+      cli::cli_abort("welfare must be numeric")
+    }
+
+    if (length(weight) > 1 & any(is.na(weight))) {
+      cli::cli_abort("No elements in weight vector can be NA - make NULL to use equal weighting")
+    }
+
+    if (is.null(povline) || !is.numeric(povline)) {
+      cli::cli_abort(
+        text = "A numeric poverty line must be specified"
+      )
+    }
+
+    if (povline < min(welfare) || povline > max(welfare)) {
+      cli::cli_alert_info(
+        text = "Note: specified poverty line is not within the welfare range"
+      )
+    }
+  })
+
+  #   ____________________________________________________________________________
+  #   Return                                                                  ####
+  return(invisible(TRUE))
+
+}
+
+
+
+check_pipmd_dist <- function() {
+  lp <- parent.frame()  |>
+    as.list()
+
+  with(lp, {
+
+    if (is.na(welfare) |> any()) {
+      cli::cli_abort("No elements in welfare vector can be NA")
+    }
+    if (!is.numeric(welfare)) {
+      cli::cli_abort("welfare must be numeric")
+    }
+    if (length(weight) > 1 & any(is.na(weight))) {
+      cli::cli_abort("No elements in weight vector can be NA - make NULL to use equal weighting")
+    }
+    if (is.null(weight)) {
+      weight <- rep(1, length = length(welfare))
+      cli::cli_alert_warning(
+        text = "No weight vector specified, each observation assigned equal weight"
+      )
+    }
+
+    if (exists("n", inherits = FALSE) &
+        exists("popshare", inherits = FALSE)) {
+      if (is.null(n) & is.null(popshare)) {
+        cli::cli_abort("Either {.arg n} or {.arg popshare} must be defined")
+      }
+    }
+  })
+  #   ____________________________________________________________________________
+  #   Return                                                                  ####
+  return(invisible(TRUE))
+}

R/data.R

@@ -5,7 +5,7 @@
 #' @format A grouped data frame with five variables:
 #' \describe{
 #' \item{\code{W}}{Weights, share of population, sum up to 100}
-#' \item{\code{X}}{welfare vector with mean welfare by decile}
+#' \item{\code{X}}{welfare vector with mean welfare by group}
 #' \item{\code{P}}{Cumulative share of population}
 #' \item{\code{L}}{Cumulative share of welfare}
 #' \item{\code{R}}{share of welfare, sum up to 1}