From ce8ce8a0a9bbf9a3d6b2bad75167cb1d0ba350bc Mon Sep 17 00:00:00 2001 From: zander-prinsloo Date: Mon, 5 Feb 2024 16:52:41 -0500 Subject: [PATCH 01/29] function to create pipster object --- R/create_pipster_object.R | 101 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 101 insertions(+) create mode 100644 R/create_pipster_object.R diff --git a/R/create_pipster_object.R b/R/create_pipster_object.R new file mode 100644 index 0000000..b048e02 --- /dev/null +++ b/R/create_pipster_object.R @@ -0,0 +1,101 @@ +#' Create Pipster Object +#' +#' The first step in using the `pipster` package is to create a pipster object. +#' It creates the appropriate classes for welfare and weights, reformats the +#' data if necessary, and, for grouped data, it estimates and selects the lorenz +#' curves to be used for the estimation of poverty and distributional measures. +#' +#' @param welfare numeric: welfare vector +#' @param weight numeric: weight vector +#' @param imputation_id numeric: vector of ids for multiply imputed data. +#' Default is NULL +#' +#' @return list: pipster object containing welfare and weights, +#' params if grouped data, imputation_id if imputed data +#' @export +#' +#' @examples +#' p <- create_pipster_object(welfare = pip_gd$L, +#' weight = pip_gd$P) +#' p +create_pipster_object <- + function(welfare, + weight = rep(1, length(welfare)), + imputation_id = NULL) { + + #_____________________________________________________________________________ + # Arguments------------------------------------------------------------------- + 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 - + leave empty to give equal weighting") + } + + #_____________________________________________________________________________ + # Class----------------------------------------------------------------------- + tp <- identify_pip_type(welfare = welfare, + weight = weight, + imputation_id = imputation_id) + cl <- substr(tp, start = 1, stop = 2) + #_____________________________________________________________________________ + # Convert format-------------------------------------------------------------- + weight <- weight[order(welfare)] + welfare <- welfare[order(welfare)] + if (tp %in% c("gd_2", "gd_3", "gd_5")) { + welfare_original <- welfare + weight_original <- weight + } + switch( + tp, + "md" = { + imputation_id <- rep(1, length(welfare)) + }, + "id" = invisible(TRUE), + "gd_1" = invisible(TRUE), + "gd_2" = { + welfare <- fcumsum(welfare)/fsum(welfare) + weight <- fcumsum(weight)/fsum(weight) + }, + "gd_3" = { + welfare <- fcumsum(welfare)/fsum(welfare) + }, + "gd_5" = { + welfare <- fcumsum(welfare)/fsum(welfare) + weight <- fcumsum(weight)/fsum(weight) + } + ) + + #_____________________________________________________________________________ + # Params---------------------------------------------------------------------- + if (cl == "gd") { + params <- pipgd_select_lorenz(welfare = welfare, + weight = weight, + complete = TRUE) + } + + #_____________________________________________________________________________ + # Return---------------------------------------------------------------------- + ret <- list( + welfare = new_vctr(welfare, + class = paste0("pipster_", cl)), + weight = new_vctr(weight, + class = paste0("pipster_", cl)) + ) + if (cl == "gd") { + ret$params <- params + } else { + ret$imputation_id <- imputation_id + } + class(ret) <- "pipster" + + ret + +} + + + From f422556fce47296251340edbf2d9a88159f63601 Mon Sep 17 00:00:00 2001 From: zander-prinsloo Date: Mon, 12 Feb 2024 22:31:01 -0500 Subject: [PATCH 02/29] assign correct pipster class --- R/create_pipster_object.R | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/R/create_pipster_object.R b/R/create_pipster_object.R index b048e02..186a118 100644 --- a/R/create_pipster_object.R +++ b/R/create_pipster_object.R @@ -80,11 +80,11 @@ create_pipster_object <- #_____________________________________________________________________________ # Return---------------------------------------------------------------------- + class_func <- paste0("new_pipster_", cl) |> + parse(text = _) ret <- list( - welfare = new_vctr(welfare, - class = paste0("pipster_", cl)), - weight = new_vctr(weight, - class = paste0("pipster_", cl)) + welfare = eval(class_func)(welfare), + weight = eval(class_func)(weight) ) if (cl == "gd") { ret$params <- params From b981b79d638230c268b7e89b322c7d43ef6f8904 Mon Sep 17 00:00:00 2001 From: zander-prinsloo Date: Mon, 12 Feb 2024 22:33:05 -0500 Subject: [PATCH 03/29] import vctrs --- DESCRIPTION | 1 + R/pipster-package.R | 2 +- 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 8db25ae..36fa5f3 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -28,6 +28,7 @@ Imports: cli, collapse (>= 2.0.9), data.table, + vctrs (>= 0.6.4), wbpip (>= 0.1.0.9012) Depends: R (>= 2.10) diff --git a/R/pipster-package.R b/R/pipster-package.R index ec6f5e5..ed2c7fa 100644 --- a/R/pipster-package.R +++ b/R/pipster-package.R @@ -12,6 +12,7 @@ #' @docType package #' @name pipster #' @import collapse +#' @import vctrs # Make sure data.table knows we know we're using it .datatable.aware = TRUE @@ -34,5 +35,4 @@ if (getRversion() >= "2.15.1") { } - NULL From 0327f891e356ac7286140960a1cfcaed24006a02 Mon Sep 17 00:00:00 2001 From: zander-prinsloo Date: Mon, 12 Feb 2024 22:34:05 -0500 Subject: [PATCH 04/29] add pipster_gd class --- R/pipster_gd.R | 179 +++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 179 insertions(+) create mode 100644 R/pipster_gd.R diff --git a/R/pipster_gd.R b/R/pipster_gd.R new file mode 100644 index 0000000..ce7d64b --- /dev/null +++ b/R/pipster_gd.R @@ -0,0 +1,179 @@ + +# constructor---- +new_pipster_gd <- function(x = double(), ...) { + new_vctr(x, class = "pipster_gd") +} + + +#' `pipster_gd` vector +#' +#' This creates a double vector of group pipster data. +#' +#' @param x +#' * For `pipster_gd`: numeric vector +#' * For `is_pipster_gd`: object to test +#' * For `as_pipster_gd`: object that should inherit `pipster_gd` class +#' +#' @return an S3 vector of class `pipster_gd` +#' @export +#' +#' @examples +#' pipster_gd(c(0.1, 0.5, 0.9, 1)) +pipster_gd <- function(x = double()) { + x <- vec_cast(x, double()) + new_pipster_gd(x) +} + +#' @export +#' @rdname pipster_gd +is_pipster_gd <- function(x) { + inherits(x, "pipster_gd") +} + +#' @export +#' @rdname pipster_gd +as_percent <- function(x) { + vec_cast(x, new_pipster_gd()) +} + +#' @export +format.pipster_gd <- function(x, ...) { + out <- formatC(signif(vec_data(x), 3)) + out[is.na(x)] <- NA + out +} + +#' @export +vec_ptype_abbr.pipster_gd <- function(x, ...) { + "pipgd" +} + + + + + + +#' @export +vec_ptype2.pipster_gd.pipster_gd <- function(x, y, ...) { + new_pipster_gd() +} + +#' @export +vec_ptype2.pipster_gd.double <- function(x, y, ...) { + double() +} + +#' @export +vec_ptype2.double.pipster_gd <- function(x, y, ...) { + double() +} + +#' @export +vec_ptype2.pipster_gd.integer <- function(x, y, ...) { + integer() +} + +#' @export +vec_ptype2.integer.pipster_gd <- function(x, y, ...) { + integer() +} + +# vec_ptype_show(pipster_gd(), double(), pipster_gd()) + +#' @export +vec_cast.pipster_gd.pipster_gd <- function(x, to, ...) { + x +} + + +#' @export +vec_cast.pipster_gd.double <- function(x, to, ...) { + pipster_gd(x) +} + +#' @export +vec_cast.double.pipster_gd <- function(x, to, ...) { + vec_data(x) +} + +# vec_cast(0.5, pipster_gd()) +# vec_cast(pipster_gd(0.5), double()) + + +#' @export +#' @method vec_arith pipster_gd +vec_arith.pipster_gd <- function(op, x, y, ...) { + UseMethod("vec_arith.pipster_gd", y) +} + + + +#' @export +#' @method vec_arith.pipster_gd default +vec_arith.pipster_gd.default <- function(op, x, y, ...) { + stop_incompatible_op(op, x, y) +} + +#' @export +#' @method vec_arith.pipster_gd pipster_gd +vec_arith.pipster_gd.pipster_gd <- function(op, x, y, ...) { + switch( + op, + "+" = new_pipster_gd(vec_arith_base(op, x, y)), + "-" = new_pipster_gd(vec_arith_base(op, x, y)), + "/" = new_pipster_gd(vec_arith_base(op, x, y)), + "*" = new_pipster_gd(vec_arith_base(op, x, y)), + stop_incompatible_op(op, x, y) + ) +} + +#' @export +#' @method vec_arith.pipster_gd numeric +vec_arith.pipster_gd.numeric <- function(op, x, y, ...) { + switch( + op, + "+" = new_pipster_gd(vec_arith_base(op, x, y)), + "-" = new_pipster_gd(vec_arith_base(op, x, y)), + "/" = new_pipster_gd(vec_arith_base(op, x, y)), + "*" = new_pipster_gd(vec_arith_base(op, x, y)), + stop_incompatible_op(op, x, y) + ) +} + +#' @export +#' @method vec_arith.numeric pipster_gd +vec_arith.numeric.pipster_gd <- function(op, x, y, ...) { + switch( + op, + "+" = new_pipster_gd(vec_arith_base(op, x, y)), + "-" = new_pipster_gd(vec_arith_base(op, x, y)), + "/" = new_pipster_gd(vec_arith_base(op, x, y)), + "*" = new_pipster_gd(vec_arith_base(op, x, y)), + stop_incompatible_op(op, x, y) + ) +} + + + +#' @export +vec_math.pipster_gd <- function(.fn, .x, ...) { + switch(.fn, + sum = attr(.x, "sum"), + mean = attr(.x, "sum") / length(.x), + vec_math_base(.fn, .x, ...) + ) +} + + + + + + + + + + + + + + From 610c63f4b45355da8dc8a0e3e666a3076ef36975 Mon Sep 17 00:00:00 2001 From: zander-prinsloo Date: Mon, 12 Feb 2024 22:35:18 -0500 Subject: [PATCH 05/29] add pipster_md class --- R/pipster_md.R | 196 +++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 196 insertions(+) create mode 100644 R/pipster_md.R diff --git a/R/pipster_md.R b/R/pipster_md.R new file mode 100644 index 0000000..5d1ec29 --- /dev/null +++ b/R/pipster_md.R @@ -0,0 +1,196 @@ + +# constructor---- +new_pipster_md <- function(x = double(), ...) { + new_vctr(x, class = "pipster_md") +} + + +#' `pipster_md` vector +#' +#' This creates a double vector of group pipster data. +#' +#' @param x +#' * For `pipster_md`: numeric vector +#' * For `is_pipster_md`: object to test +#' * For `as_pipster_md`: object that should inherit `pipster_md` class +#' +#' @return an S3 vector of class `pipster_md` +#' @export +#' +#' @examples +#' pipster_md(c(0.1, 0.5, 0.9, 1)) +pipster_md <- function(x = double()) { + x <- vec_cast(x, double()) + new_pipster_md(x) +} + +#' @export +#' @rdname pipster_md +is_pipster_md <- function(x) { + inherits(x, "pipster_md") +} + +#' @export +#' @rdname pipster_md +as_percent <- function(x) { + vec_cast(x, new_pipster_md()) +} + +#' @export +format.pipster_md <- function(x, ...) { + out <- formatC(signif(vec_data(x), 3)) + out[is.na(x)] <- NA + out +} + +#' @export +vec_ptype_abbr.pipster_md <- function(x, ...) { + "pipmd" +} + + + + + + +#' @export +vec_ptype2.pipster_md.pipster_md <- function(x, y, ...) { + new_pipster_md() +} + +#' @export +vec_ptype2.pipster_md.double <- function(x, y, ...) { + double() +} + +#' @export +vec_ptype2.double.pipster_md <- function(x, y, ...) { + double() +} + +#' @export +vec_ptype2.pipster_md.integer <- function(x, y, ...) { + integer() +} + +#' @export +vec_ptype2.integer.pipster_md <- function(x, y, ...) { + integer() +} + +# vec_ptype_show(pipster_md(), double(), pipster_md()) + +#' @export +vec_cast.pipster_md.pipster_md <- function(x, to, ...) { + x +} + + +#' @export +vec_cast.pipster_md.double <- function(x, to, ...) { + pipster_md(x) +} + +#' @export +vec_cast.double.pipster_md <- function(x, to, ...) { + vec_data(x) +} + + +#' @export +#' @method vec_arith pipster_md +vec_arith.pipster_md <- function(op, x, y, ...) { + UseMethod("vec_arith.pipster_md", y) +} + + + +#' @export +#' @method vec_arith.pipster_md default +vec_arith.pipster_md.default <- function(op, x, y, ...) { + stop_incompatible_op(op, x, y) +} + +#' @export +#' @method vec_arith.pipster_md pipster_md +vec_arith.pipster_md.pipster_md <- function(op, x, y, ...) { + switch( + op, + "+" = new_pipster_md(vec_arith_base(op, x, y)), + "-" = new_pipster_md(vec_arith_base(op, x, y)), + "/" = new_pipster_md(vec_arith_base(op, x, y)), + "*" = new_pipster_md(vec_arith_base(op, x, y)), + stop_incompatible_op(op, x, y) + ) +} + +#' @export +#' @method vec_arith.pipster_md numeric +vec_arith.pipster_md.numeric <- function(op, x, y, ...) { + switch( + op, + "+" = new_pipster_md(vec_arith_base(op, x, y)), + "-" = new_pipster_md(vec_arith_base(op, x, y)), + "/" = new_pipster_md(vec_arith_base(op, x, y)), + "*" = new_pipster_md(vec_arith_base(op, x, y)), + stop_incompatible_op(op, x, y) + ) +} + +#' @export +#' @method vec_arith.numeric pipster_md +vec_arith.numeric.pipster_md <- function(op, x, y, ...) { + switch( + op, + "+" = new_pipster_md(vec_arith_base(op, x, y)), + "-" = new_pipster_md(vec_arith_base(op, x, y)), + "/" = new_pipster_md(vec_arith_base(op, x, y)), + "*" = new_pipster_md(vec_arith_base(op, x, y)), + stop_incompatible_op(op, x, y) + ) +} + + + + +#' @export +vec_math.pipster_md <- function(.fn, .x, ...) { + switch(.fn, + sum = attr(.x, "sum"), + mean = attr(.x, "sum") / length(.x), + vec_math_base(.fn, .x, ...) + ) +} + + + + + + + + + + + +#' Warning message used in default methods for all pipster S3 generic functions +#' +#' @param generic_name character: name of generic function of default method +#' @param first_arg object: first argument in the generic function, the class of +#' which determines the S3 method. +#' +#' @return warning message +#' @keywords internal +default_warning_message <- function(generic_name, first_arg){ + cli::cli_warn(paste0(generic_name, " does not know how to handle object of class ", + class(first_arg), + " and can only be used for classes `pipster_gd` and `pipster_md`.")) +} + + + + + + + + +# From 3ecee6e821f060c4f694d5aa7e1623635dc9375f Mon Sep 17 00:00:00 2001 From: zander-prinsloo Date: Mon, 12 Feb 2024 22:48:04 -0500 Subject: [PATCH 06/29] add pipster_object to args --- R/pipgd_dist.R | 130 ++++++++++++++++++++++++++----------------------- R/pipmd_dist.R | 102 ++++++++++++++++++++++++++------------ 2 files changed, 140 insertions(+), 92 deletions(-) diff --git a/R/pipgd_dist.R b/R/pipgd_dist.R index e182a30..6acb635 100644 --- a/R/pipgd_dist.R +++ b/R/pipgd_dist.R @@ -10,6 +10,7 @@ #' share of welfare in each. #' #' @inheritParams pipgd_select_lorenz +#' @param pipster_object pipster object created using [create_pipster_object] #' @param lorenz character or NULL. Lorenz curve selected. It could be "lq" for #' Lorenz Quadratic or "lb" for Lorenz Beta #' @param popshare numeric: vector of share of population. Default is `seq(from @@ -58,13 +59,14 @@ #' complete = TRUE) #' pipgd_welfare_share_at <- function( - params = NULL, - welfare = NULL, - weight = NULL, - complete = getOption("pipster.return_complete"), - lorenz = NULL, - n = 10, - popshare = seq(from = 1/n, to = 1, by = 1/n) + pipster_object = NULL, + params = NULL, + welfare = NULL, + weight = NULL, + complete = getOption("pipster.return_complete"), + lorenz = NULL, + n = 10, + popshare = seq(from = 1/n, to = 1, by = 1/n) ) { # ____________________________________________________________________________ @@ -74,15 +76,10 @@ pipgd_welfare_share_at <- function( # ____________________________________________________ # Computations #### - if (!is.null(welfare)) { - params <- pipgd_select_lorenz(welfare = welfare, - weight = weight, - complete = TRUE) - } else { - params <- pipgd_select_lorenz(welfare = params$data$welfare, - weight = params$data$weight, - complete = TRUE) - } + params <- validate_params(pipster_object = pipster_object, + welfare = welfare, + weight = weight, + params = params) if (is.null(lorenz)) { lorenz <- params$selected_lorenz$for_dist @@ -166,13 +163,14 @@ pipgd_welfare_share_at <- function( #' complete = TRUE) #' pipgd_quantile_welfare_share <- - function(params = NULL, - welfare = NULL, - weight = NULL, - complete = getOption("pipster.return_complete"), - lorenz = NULL, - n = 10, - popshare = seq(from = 1/n, to = 1, by = 1/n)) { + function(pipster_object = NULL, + params = NULL, + welfare = NULL, + weight = NULL, + complete = getOption("pipster.return_complete"), + lorenz = NULL, + n = 10, + popshare = seq(from = 1/n, to = 1, by = 1/n)) { # _________________________________________________________________ # Defenses #### @@ -182,15 +180,10 @@ pipgd_quantile_welfare_share <- # ____________________________________________________ # Computations #### - if (!is.null(welfare)) { - params <- pipgd_select_lorenz(welfare = welfare, - weight = weight, - complete = TRUE) - } else { - params <- pipgd_select_lorenz(welfare = params$data$welfare, - weight = params$data$weight, - complete = TRUE) - } + params <- validate_params(pipster_object = pipster_object, + welfare = welfare, + weight = weight, + params = params) if (is.null(lorenz)) { lorenz <- params$selected_lorenz$for_dist @@ -280,9 +273,9 @@ pipgd_quantile_welfare_share <- #' weight = pip_gd$P, #' mean = 1.5, #' complete = TRUE) - pipgd_quantile <- - function(params = NULL, + function(pipster_object = NULL, + params = NULL, welfare = NULL, weight = NULL, n = 10, @@ -296,18 +289,12 @@ pipgd_quantile <- pl <- as.list(environment()) check_pipgd_params(pl) - # ____________________________________________________ # Computations #### - if (!is.null(welfare)) { - params <- pipgd_select_lorenz(welfare = welfare, - weight = weight, - complete = TRUE) - } else { - params <- pipgd_select_lorenz(welfare = params$data$welfare, - weight = params$data$weight, - complete = TRUE) - } + params <- validate_params(pipster_object = pipster_object, + welfare = welfare, + weight = weight, + params = params) if (is.null(lorenz)) { lorenz <- params$selected_lorenz$for_dist @@ -317,9 +304,6 @@ pipgd_quantile <- qfun <- paste0("wbpip::derive_", lorenz) |> parse(text = _) - # value_at_vc <- Vectorize(eval(qfun), - # vectorize.args = "x", - # SIMPLIFY = TRUE) qt <- eval(qfun)(x = popshare, params$gd_params[[lorenz]]$reg_results$coef[["A"]], @@ -367,6 +351,7 @@ pipgd_quantile <- #' weight = pip_gd$P, #' complete = TRUE) pipgd_gini <- function( + pipster_object = NULL, params = NULL, welfare = NULL, weight = NULL, @@ -383,13 +368,10 @@ pipgd_gini <- function( # _________________________________________________________________ # Params # _________________________________________________________________ - if (!is.null(welfare)) { - params <- pipgd_select_lorenz( - welfare = welfare, - weight = weight, - complete = TRUE - ) - } + params <- validate_params(pipster_object = pipster_object, + welfare = welfare, + weight = weight, + params = params) # _________________________________________________________________ # Select Lorenz @@ -469,6 +451,7 @@ pipgd_gini <- function( #' complete = TRUE) #' pipgd_mld <- function( + pipster_object = NULL, params = NULL, welfare = NULL, weight = NULL, @@ -485,13 +468,10 @@ pipgd_mld <- function( # _________________________________________________________________ # Params # _________________________________________________________________ - if (!is.null(welfare)) { - params <- pipgd_select_lorenz( - welfare = welfare, - weight = weight, - complete = TRUE - ) - } + params <- validate_params(pipster_object = pipster_object, + welfare = welfare, + weight = weight, + params = params) # _________________________________________________________________ # Select Lorenz @@ -531,7 +511,35 @@ pipgd_mld <- function( +#' Validate group data parameters +#' +#' @inheritParams pipgd_welfare_share_at +#' +#' @return list: `params` to be used in gd functions +#' @keywords internal +validate_params <- function( + pipster_object, + welfare, + weight, + params +){ + + if (!is.null(pipster_object)) { + + params <- pipster_object$params + + } else if (!is.null(welfare)) { + params <- pipgd_select_lorenz(welfare = welfare, + weight = weight, + complete = TRUE) + } else { + params <- pipgd_select_lorenz(welfare = params$data$welfare, + weight = params$data$weight, + complete = TRUE) + } + params +} diff --git a/R/pipmd_dist.R b/R/pipmd_dist.R index 5c912d5..0581f98 100644 --- a/R/pipmd_dist.R +++ b/R/pipmd_dist.R @@ -17,6 +17,7 @@ #' default, the mean is equal to 1, which implies that, if no mean value if #' provided, the return value is equal to `x`. #' +#' @param pipster_object pipster object created using [create_pipster_object] #' @param welfare welfare vector #' @param weight population weight vector #' @param n numeric: number of equi-spaced quantiles @@ -30,7 +31,6 @@ #' #' @export #' -#' #' @examples #' # Example 1: Calculating quintiles. #' pipmd_quantile(welfare = pip_md_s$welfare, @@ -52,17 +52,24 @@ #' format = "atomic") #' pipmd_quantile <- function( - welfare , - weight = rep(1, length = length(welfare)), - n = 10, - popshare = seq(from = 1/n, to = 1, by = 1/n), - format = c("dt", "list", "atomic") + pipster_object = NULL, + welfare = NULL, + weight = rep(1, length = length(welfare)), + n = 10, + popshare = seq(from = 1/n, to = 1, by = 1/n), + format = c("dt", "list", "atomic") ){ # ____________________________________________________________________________ # Arguments ------------------------------------------------------------------ format <- match.arg(format) + # Use pipster_object + if (!is.null(pipster_object)) { + welfare <- pipster_object$welfare |> unclass() + weight <- pipster_object$weight |> unclass() + } + # defenses --------- check_pipmd_dist() @@ -126,16 +133,23 @@ pipmd_quantile <- function( #' format = "atomic") #' pipmd_welfare_share_at <- function( - welfare , - weight = rep(1, length = length(welfare)), - n = 10, - popshare = seq(from = 1/n, to = 1, by = 1/n), - format = c("dt", "list", "atomic") + pipster_object = NULL, + welfare = NULL, + weight = rep(1, length = length(welfare)), + n = 10, + popshare = seq(from = 1/n, to = 1, by = 1/n), + format = c("dt", "list", "atomic") ){ # ____________________________________________________________________________ # Arguments ------------------------------------------------------------------ format <- match.arg(format) + # Use pipster_object + if (!is.null(pipster_object)) { + welfare <- pipster_object$welfare |> unclass() + weight <- pipster_object$weight |> unclass() + } + # defenses --------- check_pipmd_dist() @@ -201,20 +215,26 @@ pipmd_welfare_share_at <- function( #' format = "atomic") #' pipmd_quantile_welfare_share <- function( + pipster_object = NULL, welfare , - weight = rep(1, length = length(welfare)), - n = 10, - popshare = seq(from = 1/n, to = 1, by = 1/n), - format = c("dt", "list", "atomic")) + weight = rep(1, length = length(welfare)), + n = 10, + popshare = seq(from = 1/n, to = 1, by = 1/n), + format = c("dt", "list", "atomic")) { # ____________________________________________________________________________ # Arguments ------------------------------------------------------------------ format <- match.arg(format) + # Use pipster_object + if (!is.null(pipster_object)) { + welfare <- pipster_object$welfare |> unclass() + weight <- pipster_object$weight |> unclass() + } + # defenses --------- check_pipmd_dist() - # ____________________________________________________________________________ # Calculations --------------------------------------------------------------- output <- wbpip::md_quantile_welfare_share( @@ -268,14 +288,21 @@ pipmd_quantile_welfare_share <- function( #' format = "list") #' pipmd_gini <- function( - welfare , - weight = rep(1, length = length(welfare)), - format = c("dt", "list", "atomic")) + pipster_object = NULL, + welfare, + weight = rep(1, length = length(welfare)), + format = c("dt", "list", "atomic")) { # _____________________________________ # Arguments --------------------------- format <- match.arg(format) + # Use pipster_object + if (!is.null(pipster_object)) { + welfare <- pipster_object$welfare |> unclass() + weight <- pipster_object$weight |> unclass() + } + # defenses --------- check_pipmd_dist() @@ -343,17 +370,24 @@ pipmd_gini <- function( #' format = "atomic") #' pipmd_polarization <- function( - welfare , - weight = rep(1, length = length(welfare)), - gini = NULL, - mean = NULL, - median = NULL, - format = c("dt", "list", "atomic") + pipster_object = NULL, + welfare, + weight = rep(1, length = length(welfare)), + gini = NULL, + mean = NULL, + median = NULL, + format = c("dt", "list", "atomic") ){ # ____________________________________________________________________________ # Arguments ------------------------------------------------------------------ format <- match.arg(format) + # Use pipster_object + if (!is.null(pipster_object)) { + welfare <- pipster_object$welfare |> unclass() + weight <- pipster_object$weight |> unclass() + } + # defenses --------- check_pipmd_dist() @@ -397,7 +431,6 @@ pipmd_polarization <- function( #' Given a vector of weights and welfare, this functions computes the #' Mean Log Deviation (MLD). #' -#' #' @inheritParams pipmd_polarization #' #' @return Returns a `data.table` and `data.frame` object with two variables: @@ -427,22 +460,29 @@ pipmd_polarization <- function( #' format = "list") #' pipmd_mld <- function( + pipster_object = NULL, welfare , - weight = rep(1, length = length(welfare)), - mean = NULL, - format = c("dt", "list", "atomic") + weight = rep(1, length = length(welfare)), + mean = NULL, + format = c("dt", "list", "atomic") ){ # ____________________________________________________________________________ # Arguments ------------------------------------------------------------------ format <- match.arg(format) - # defenses --------- - check_pipmd_dist() + # Use pipster_object + if (!is.null(pipster_object)) { + welfare <- pipster_object$welfare |> unclass() + weight <- pipster_object$weight |> unclass() + } if (is.null(mean)) { mean <- fmean(x = welfare,w = weight) } + # defenses --------- + check_pipmd_dist() + # ____________________________________________________________________________ # Calculations --------------------------------------------------------------- p <- wbpip::md_compute_mld( From 3c14d3e1075f99dcf6eeec745aead3631abd1b9b Mon Sep 17 00:00:00 2001 From: zander-prinsloo Date: Mon, 12 Feb 2024 22:49:35 -0500 Subject: [PATCH 07/29] S3 methods - dist stats --- R/get_dist.R | 665 +++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 665 insertions(+) create mode 100644 R/get_dist.R diff --git a/R/get_dist.R b/R/get_dist.R new file mode 100644 index 0000000..e6fcadf --- /dev/null +++ b/R/get_dist.R @@ -0,0 +1,665 @@ +# Quantile------------------------------------ + + +#' Quantile welfare values +#' +#' Gives the `n` quantile welfare values for the given welfare and weight vectors. +#' This is a generic function. +#' +#' @param pipster_object pipster object created using [create_pipster_object] +#' @inheritParams pipgd_quantile +#' +#' @return list +#' @export +get_quantile <- function(pipster_object, + n = 10, + popshare = seq(from = 1/n, + to = 1, + by = 1/n), + ... ) { + welfare <- pipster_object$welfare + UseMethod("get_quantile", object = welfare) +} + + +#' Quantile welfare values +#' +#' Gives the `n` quantile welfare values for the given welfare and weight vectors. +#' This is for `pipster_gd` grouped data objects. This is a wrapper +#' over [pipgd_quantile]. Requires a pipster object of class `pipster_gd` +#' (grouped data object). +#' +#' @inheritParams get_quantile +#' @param ... additional arguments passed to [pipgd_quantile] +#' +#' @return list +#' @export +get_quantile.pipster_gd <- + function(pipster_object, + n = 10, + popshare = seq(from = 1/n, + to = 1, + by = 1/n), + ...) { + + # Computations + res <- pipgd_quantile(pipster_object = pipster_object, + n = n, + popshare = popshare, + ...) + + # Format + res_list <- res$dist_stats$quantile |> + as.list() + names(res_list) <- paste0(res$dist_stats$popshare*100, + "%") + + res_list + +} + + +#' Quantile welfare values +#' +#' Gives the `n` quantile welfare values for the given welfare and weight vectors. +#' This is for `pipster_gd` grouped data objects. This is a wrapper +#' over [pipmd_quantile], which should be viewed for more detail. +#' +#' @inheritParams get_quantile +#' @param ... additional arguments passed to [pipmd_quantile] +#' +#' @return list +#' @export +get_quantile.pipster_md <- + function(pipster_object, + n = 10, + popshare = seq(from = 1/n, + to = 1, + by = 1/n), + ...) { + + pipmd_quantile(pipster_object = pipster_object, + n = n, + popshare = popshare, + format = "list", + ...) +} + + +#' Quantile welfare values +#' +#' This default S3 method returns an error when called +#' +#' @inheritParams get_quantile +#' @param ... additional arguments +#' +#' @return list +#' @export +get_quantile.default <- + function(pipster_object, + n = 10, + popshare = seq(from = 1/n, + to = 1, + by = 1/n), + ...) { + + cli::cli_abort("No default exist. Please check object class.") +} + + +# Welfare share at------------------------------------ + + +#' Welfare share by quantile +#' +#' Generic function. Returns the share of welfare held by the specified +#' share of the population in the parameter `popshare`. Alternatively, you can +#' select the number of quantiles (10 be default), to estimate the corresponding +#' share of welfare in each. +#' +#' @param pipster_object pipster object created using [create_pipster_object] +#' @inheritParams pipgd_welfare_share_at +#' +#' @return list +#' @export +get_welfare_share_at <- function(pipster_object, + n = 10, + popshare = seq(from = 1/n, + to = 1, + by = 1/n), + ... ) { + + welfare <- pipster_object$welfare + + UseMethod("get_welfare_share_at", object = welfare) +} + + + +#' Welfare share by quantile in group data +#' +#' Returns the share of welfare held by the specified +#' share of the population in the parameter `popshare`. Alternatively, you can +#' select the number of quantiles (10 be default), to estimate the corresponding +#' share of welfare in each. +#' +#' Requires a pipster object of class `pipster_gd` (grouped data object). +#' This is a wrapper over [pipgd_welfare_share_at], which should be viewed +#' for more detail. +#' +#' @inheritParams get_welfare_share_at +#' @param ... additional arguments passed to [pipgd_welfare_share_at] +#' +#' @return list +#' @export +get_welfare_share_at.pipster_gd <- + function(pipster_object, + n = 10, + popshare = seq(from = 1/n, + to = 1, + by = 1/n), + ...) { + + # Computations + res <- pipgd_welfare_share_at(pipster_object = pipster_object, + n = n, + popshare = popshare, + ...) + + # Format + res_list <- res$dist_stats$welfare_share_at |> + as.list() + names(res_list) <- paste0(res$dist_stats$popshare*100, + "%") + + res_list + +} + + +#' Quantile welfare values +#' +#' Gives the `n` quantile welfare values for the given welfare and weight vectors. +#' +#' Requires a pipster object of class `pipster_md` (grouped data object). +#' This is a wrapper over [pipmd_welfare_share_at], which should be viewed +#' for more detail. +#' +#' @inheritParams get_welfare_share_at +#' @param ... additional arguments passed to [pipmd_welfare_share_at] +#' +#' @return list +#' @export +get_welfare_share_at.pipster_md <- + function(pipster_object, + n = 10, + popshare = seq(from = 1/n, + to = 1, + by = 1/n), + ...) { + + pipmd_welfare_share_at(pipster_object = pipster_object, + n = n, + popshare = popshare, + format = "list", + ...) +} + + +#' Quantile welfare values +#' +#' This default S3 method returns an error when called. +#' +#' @inheritParams get_welfare_share_at +#' @param ... additional arguments +#' +#' @return list +#' @export +get_welfare_share_at.default <- + function(pipster_object, + n = 10, + popshare = seq(from = 1/n, + to = 1, + by = 1/n), + ...) { + + cli::cli_abort("No default exist. Please check object class.") +} + + + + +# Quantile welfare share ------------------------------------ + + +#' Quantile welfare share +#' +#' This is a generic function. +#' `get_quantile_welfare_share` returns the share of welfare held by a +#' particular quantile. Notice that [get_welfare_share_at] gets the share of +#' welfare held by a particular share of the population, which is essentially +#' the cumulative share. Instead, `get_quantile_welfare_share` returns +#' the proportion of welfare that only the specified quantile holds. +#' +#' @param pipster_object pipster object created using [create_pipster_object] +#' @inheritParams pipgd_quantile_welfare_share +#' +#' @return list +#' @export +get_quantile_welfare_share <- + function(pipster_object, + n = 10, + popshare = seq(from = 1/n, + to = 1, + by = 1/n), + ... ) { + + welfare <- pipster_object$welfare + + UseMethod("get_quantile_welfare_share", + object = welfare) +} + + + +#' Quantile welfare share in group data +#' +#' This is a generic function. +#' `get_quantile_welfare_share` returns the share of welfare held by a +#' particular quantile. Notice that [get_welfare_share_at] gets the share of +#' welfare held by a particular share of the population, which is essentially +#' the cumulative share. Instead, `get_quantile_welfare_share` returns +#' the proportion of welfare that only the specified quantile holds. +#' +#' Requires a pipster object of class `pipster_gd` (grouped data object). +#' This is a wrapper over [pipgd_quantile_welfare_share], which should be viewed +#' for more detail. +#' +#' @inheritParams get_quantile_welfare_share +#' @param ... additional arguments passed to [pipgd_quantile_welfare_share] +#' +#' @return list +#' @export +get_quantile_welfare_share.pipster_gd <- + function(pipster_object, + n = 10, + popshare = seq(from = 1/n, + to = 1, + by = 1/n), + ...) { + + # Computations + res <- + pipgd_quantile_welfare_share(pipster_object = pipster_object, + n = n, + popshare = popshare, + ...) + + # Format + res_list <- res$dist_stats$quantile_welfare_share |> + as.list() + names(res_list) <- paste0(res$dist_stats$popshare*100, + "%") + + res_list + + } + + +#' Quantile welfare share in micro data +#' +#' This is a generic function. +#' `get_quantile_welfare_share` returns the share of welfare held by a +#' particular quantile. Notice that [get_welfare_share_at] gets the share of +#' welfare held by a particular share of the population, which is essentially +#' the cumulative share. Instead, `get_quantile_welfare_share` returns +#' the proportion of welfare that only the specified quantile holds. +#' +#' Requires a pipster object of class `pipster_md` (micro data object). +#' This is a wrapper over [pipmd_quantile_welfare_share], which should be viewed +#' for more detail. +#' +#' @inheritParams get_quantile_welfare_share +#' @param ... additional arguments passed to [pipmd_quantile_welfare_share] +#' +#' @return list +#' @export +get_quantile_welfare_share.pipster_md <- + function(pipster_object, + n = 10, + popshare = seq(from = 1/n, + to = 1, + by = 1/n), + ...) { + + pipmd_quantile_welfare_share(pipster_object = pipster_object, + n = n, + popshare = popshare, + format = "list", + ...) + } + + +#' Quantile welfare values +#' +#' This default S3 method returns an error when called +#' +#' @inheritParams get_quantile_welfare_share +#' @param ... additional arguments +#' +#' @return list +#' @export +get_quantile_welfare_share.default <- + function(pipster_object, + n = 10, + popshare = seq(from = 1/n, + to = 1, + by = 1/n), + ...) { + + cli::cli_abort("No default exist. Please check object class.") + } + + +# gini ------------------------------------ + + +#' Gini coefficient +#' +#' This is a generic function calculating the gini coefficient. +#' +#' @param pipster_object pipster object created using [create_pipster_object] +#' @inheritParams pipgd_gini +#' +#' @return list +#' @export +get_gini <- + function(pipster_object, + ... ) { + + welfare <- pipster_object$welfare + + UseMethod("get_gini", + object = welfare) + } + + + +#' Gini coefficient on group data +#' +#' This is a method for computing the gini coefficient on group data. +#' Requires a pipster object of class `pipster_gd` (grouped data object). +#' This is a wrapper over [pipgd_gini], which should be viewed +#' for more detail. +#' +#' @inheritParams get_gini +#' @param ... additional arguments passed to [pipgd_gini] +#' +#' @return list +#' @export +get_gini.pipster_gd <- + function(pipster_object, + ...) { + + # Computations + res <- + pipgd_gini(pipster_object = pipster_object, + ...) + + # Format + res <- res$dist_stats + + res + + } + + +#' Gini coefficient on micro data +#' +#' This is a method for computing the gini coefficient on micro data. +#' Requires a pipster object of class `pipster_md` (grouped micro object). +#' This is a wrapper over [pipmd_gini], which should be viewed +#' for more detail. +#' +#' @inheritParams get_gini +#' @param ... additional arguments passed to [pipmd_gini] +#' +#' @return list +#' @export +get_gini.pipster_md <- + function(pipster_object, + ...) { + + pipmd_gini(pipster_object = pipster_object, + format = "list", + ...) + } + + +#' Gini coefficient S3 default +#' +#' This default S3 method returns an error when called +#' +#' @inheritParams get_gini +#' @param ... additional arguments +#' +#' @return list +#' @export +get_gini.default <- + function(pipster_object, + ...) { + + cli::cli_abort("No default exist. Please check object class.") + } + + + + +# Polarization ------------------------------------ + + +#' Wolfson polarization index +#' +#' This is a generic function to compute the Wolfson polarization index. +#' +#' @param pipster_object pipster object created using [create_pipster_object] +#' @inheritParams pipmd_polarization +#' +#' @return list +#' @export +get_polarization <- + function(pipster_object, + ... ) { + + welfare <- pipster_object$welfare + + UseMethod("get_polarization", + object = welfare) + } + + + +#' Wolfson polarization index +#' +#' This is a method to compute the Wolfson polarization index on group data. +#' Requires a pipster object of class `pipster_gd` (grouped data object). +#' This is a wrapper over pipgd_polarization, which should be viewed +#' for more detail. +#' +#' @inheritParams get_polarization +#' @param ... additional arguments passed to pipgd_polarization +#' +#' @return list +#' @export +get_polarization.pipster_gd <- + function(pipster_object, + ...) { + return("to be implemented") + # Computations + #res <- + # pipgd_polarization(pipster_object = pipster_object, + # ...) + + # Format + res <- res$dist_stats + + res + + } + + +#' Wolfson polarization index +#' +#' This is a method to compute the Wolfson polarization index on micro data. +#' Requires a pipster object of class `pipster_md` (micro data object). +#' This is a wrapper over [pipmd_polarization], which should be viewed +#' for more detail. +#' +#' @inheritParams get_polarization +#' @param ... additional arguments passed to [pipmd_polarization] +#' +#' @return list +#' @export +get_polarization.pipster_md <- + function(pipster_object, + ...) { + + pipmd_polarization(pipster_object = pipster_object, + format = "list", + ...) + } + + +#' Gini coefficient S3 default +#' +#' This default S3 method returns an error when called +#' +#' @inheritParams get_polarization +#' @param ... additional arguments +#' +#' @return list +#' @export +get_polarization.default <- + function(pipster_object, + ...) { + + cli::cli_abort("No default exist. Please check object class.") + } + + + + +# MLD ------------------------------------ + + +#' Mean Log Deviation +#' +#' This is a generic function to compute the +#' Mean Log Deviation (MLD). +#' +#' @param pipster_object pipster object created using [create_pipster_object] +#' @inheritParams pipmd_mld +#' +#' @return list +#' @export +get_mld <- + function(pipster_object, + ... ) { + + welfare <- pipster_object$welfare + + UseMethod("get_mld", + object = welfare) + } + + + +#' Mean Log Deviation (MLD) for group data +#' +#' This is a method to compute the MLD on group data. +#' Requires a pipster object of class `pipster_gd` (grouped data object). +#' This is a wrapper over [pipgd_mld], which should be viewed +#' for more detail. +#' +#' @inheritParams get_mld +#' @param ... additional arguments passed to pipgd_mld +#' +#' @return list +#' @export +get_mld.pipster_gd <- + function(pipster_object, + ...) { + + # Computations + res <- + pipgd_mld(pipster_object = pipster_object, + ...) + + # Format + res <- res$dist_stats + + res + + } + + +#' Wolfson polarization index +#' +#' This is a method to compute the Wolfson polarization index on micro data. +#' Requires a pipster object of class `pipster_md` (micro data object). +#' This is a wrapper over [pipmd_polarization], which should be viewed +#' for more detail. +#' +#' @inheritParams get_mld +#' @param ... additional arguments passed to [pipmd_polarization] +#' +#' @return list +#' @export +get_mld.pipster_md <- + function(pipster_object, + ...) { + + pipmd_mld(pipster_object = pipster_object, + format = "list", + ...) + } + + +#' Gini coefficient S3 default +#' +#' This default S3 method returns an error when called +#' +#' @inheritParams get_mld +#' @param ... additional arguments +#' +#' @return list +#' @export +get_mld.default <- + function(pipster_object, + ...) { + + cli::cli_abort("No default exist. Please check object class.") + } + + + + + + + + + + + + + + + + + + + + + + + From 2260e244839aaf1989834cdaea668ace820a1a05 Mon Sep 17 00:00:00 2001 From: RossanaTat Date: Tue, 13 Feb 2024 14:04:00 -0500 Subject: [PATCH 08/29] pipgd_polarization function, documentation and tests --- NAMESPACE | 1 + R/pipgd_dist.R | 128 ++++++++++++++++++++++++ man/pipgd_polarization.Rd | 66 +++++++++++++ tests/testthat/test-pipgd_dist.R | 161 +++++++++++++++++++++++++++++++ 4 files changed, 356 insertions(+) create mode 100644 man/pipgd_polarization.Rd diff --git a/NAMESPACE b/NAMESPACE index 269937c..c6f0d3f 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -6,6 +6,7 @@ export(pipgd_gini) export(pipgd_lorenz_curve) export(pipgd_mld) export(pipgd_params) +export(pipgd_polarization) export(pipgd_pov_gap) export(pipgd_pov_headcount) export(pipgd_pov_severity) diff --git a/R/pipgd_dist.R b/R/pipgd_dist.R index e182a30..1ff7508 100644 --- a/R/pipgd_dist.R +++ b/R/pipgd_dist.R @@ -529,8 +529,136 @@ pipgd_mld <- function( } +#' Compute polarization index +#' +#' This function computes polarization index of the distribution (for grouped data) +#' +#' +#' @inheritParams pipgd_gini +#' @param gini numeric scalar of gini index, from `pipgd_gini()` or user supplied +#' @param mean numeric scalar of distribution mean. Default is 1 +#' +#' @return Returns a nested list containing: +#' `$dist_stats$polarization` a numeric vector containing the index of polarization of the distribution; +#' `$dist_stats$lorenz` a character vector specifying which Lorenz curve is used. +#' If `complete = TRUE`, it returns a `pipgd_params` object with additional +#' details and intermediate calculations. +#' +#' @export +#' +#' @examples +#' # Example with welfare and weight vectors +#' pipgd_polarization(welfare = pip_gd$L, +#' weight = pip_gd$P) +#' +#' # Example with list of params +#' # Params from `pipgd_select_lorenz()` +#' params = pipgd_select_lorenz(welfare = pip_gd$L, +#' weight = pip_gd$P, +#' complete = TRUE) +#' pipgd_polarization(params = params) +#' +#' # Example with a specific Lorenz +#' pipgd_polarization(welfare = pip_gd$L, +#' weight = pip_gd$P, +#' lorenz = "lb") +#' +#' # Example with complete output +#' pipgd_polarization(welfare = pip_gd$L, +#' weight = pip_gd$P, +#' complete = TRUE) +#' + +pipgd_polarization <- function( + params = NULL, + welfare = NULL, + weight = NULL, + mean = 1, + gini = NULL, + complete = getOption("pipster.return_complete"), + lorenz = NULL +){ + + # _________________________________________________________________ + # Defenses + # _________________________________________________________________ + + pl <- as.list(environment()) + check_pipgd_params(pl) + + # _________________________________________________________________ + # Params + # _________________________________________________________________ + + if (!is.null(welfare)) { + params <- pipgd_select_lorenz( + welfare = welfare, + weight = weight, + complete = TRUE + ) + } + # _________________________________________________________________ + # Select Lorenz + # _________________________________________________________________ + + if (is.null(lorenz)) { + lorenz <- params$selected_lorenz$for_dist + } else { + match.arg(lorenz, c("lq", "lb")) + } + + + # _________________________________________________________________ + # Set p0 and compute dcm + # _________________________________________________________________ + + # p0 - always 0.5 + p0 = 0.5 + mean = mean + + # gini + + if (is.null(gini)) { + gini <- pipgd_gini(welfare = params$data$welfare, + weight = params$data$weight, + lorenz = lorenz)$dist_stats$gini + } else { + gini <- gini + } + + dcm = (1 - gini)*mean + + # Compute polarization index + polarization_ <- paste0("wbpip:::gd_compute_polarization_", lorenz) |> + parse(text = _) + + polarization <- eval(polarization_)( + mean = mean, + p0 = p0, + dcm = dcm, + A = params$gd_params[[lorenz]]$reg_results$coef[["A"]], + B = params$gd_params[[lorenz]]$reg_results$coef[["B"]], + C = params$gd_params[[lorenz]]$reg_results$coef[["C"]] + ) + + attributes(polarization) <- NULL + + # ____________________________________________________ + # Return #### + + + if (isFALSE(complete)) { + params <- vector("list") + } + + params$dist_stats$polarization <- polarization + params$dist_stats$lorenz <- lorenz + + params + +} diff --git a/man/pipgd_polarization.Rd b/man/pipgd_polarization.Rd new file mode 100644 index 0000000..3b845a8 --- /dev/null +++ b/man/pipgd_polarization.Rd @@ -0,0 +1,66 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/pipgd_dist.R +\name{pipgd_polarization} +\alias{pipgd_polarization} +\title{Compute polarization index} +\usage{ +pipgd_polarization( + params = NULL, + welfare = NULL, + weight = NULL, + mean = 1, + gini = NULL, + complete = getOption("pipster.return_complete"), + lorenz = NULL +) +} +\arguments{ +\item{params}{list of parameters from \code{pipgd_validate_lorenz()}} + +\item{welfare}{numeric vector of cumulative share of welfare (income/consumption)} + +\item{weight}{numeric vector of cumulative share of the population} + +\item{mean}{numeric scalar of distribution mean. Default is 1} + +\item{gini}{numeric scalar of gini index, from \code{pipgd_gini()} or user supplied} + +\item{complete}{logical: If TRUE, returns a list a cumulative returns from +previously used \code{get_gd} functions. Default is \code{FALSE}} + +\item{lorenz}{character or NULL. Lorenz curve selected. It could be "lq" for +Lorenz Quadratic or "lb" for Lorenz Beta} +} +\value{ +Returns a nested list containing: +\verb{$dist_stats$polarization} a numeric vector containing the index of polarization of the distribution; +\verb{$dist_stats$lorenz} a character vector specifying which Lorenz curve is used. +If \code{complete = TRUE}, it returns a \code{pipgd_params} object with additional +details and intermediate calculations. +} +\description{ +This function computes polarization index of the distribution (for grouped data) +} +\examples{ +# Example with welfare and weight vectors +pipgd_polarization(welfare = pip_gd$L, + weight = pip_gd$P) + +# Example with list of params +# Params from `pipgd_select_lorenz()` +params = pipgd_select_lorenz(welfare = pip_gd$L, + weight = pip_gd$P, + complete = TRUE) +pipgd_polarization(params = params) + +# Example with a specific Lorenz +pipgd_polarization(welfare = pip_gd$L, + weight = pip_gd$P, + lorenz = "lb") + +# Example with complete output +pipgd_polarization(welfare = pip_gd$L, + weight = pip_gd$P, + complete = TRUE) + +} diff --git a/tests/testthat/test-pipgd_dist.R b/tests/testthat/test-pipgd_dist.R index 88b3e68..0808a00 100644 --- a/tests/testthat/test-pipgd_dist.R +++ b/tests/testthat/test-pipgd_dist.R @@ -887,4 +887,165 @@ test_that("pipgd_mld calculates mld as expected", { }) +# Test pipgd_polarization #### +# Inputs ----------------------------------------------------------------- +test_that("pipgd_polarization inputs works as expected", { + + pipgd_polarization(welfare = welfare, + weight = NULL) |> + expect_error() + + pipgd_polarization(welfare = NULL, + weight = weight) |> + expect_error() + + pipgd_polarization(welfare = welfare, + weight = weight, + mean = "invalid mean") |> + expect_error() + + pipgd_polarization(welfare = welfare, + weight = weight, + gini = "invalid gini") |> + expect_error() + + pipgd_polarization(welfare = welfare, + weight = weight, + lorenz = "Neither NULL, lq or lb") |> + expect_error() + + pipgd_polarization(welfare = welfare, + weight = weight, + lorenz = NULL) |> + expect_no_error() + + pipgd_polarization(params = params, + lorenz = NULL) |> + expect_no_error() + +}) + +# Outputs ----------------------------------------------------------------- +test_that("pipgd_polarization outputs work as expected", { + + res <- pipgd_polarization(welfare = welfare, + weight = weight) + res_params <- pipgd_polarization(params = params) + res_complete <- pipgd_polarization(welfare = welfare, + weight = weight, + complete = TRUE) + res |> + expect_equal(res_params) + + class(res) |> + expect_equal("list") + + class(res_complete) |> + expect_equal("pipgd_params") + + names(res) |> + expect_equal("dist_stats") + + names(res$dist_stats) |> + expect_equal(c("polarization", + "lorenz")) + + # Names in output list when complete = TRUE + names(res_complete) |> + expect_equal(c("gd_params", + "data", + "selected_lorenz", + "dist_stats")) + + names(res_complete$gd_params) |> + expect_equal(c("lq", + "lb")) + + names(res_complete$gd_params$lq) |> + expect_equal(names(res_complete$gd_params$lb)) + + names(res_complete$gd_params$lq) |> + expect_equal(c("reg_results", + "key_values", + "validity")) + + names(res_complete$gd_params$lq$reg_results) |> + expect_equal(c("ymean", + "sst", + "coef", + "sse", + "r2", + "mse", + "se")) + + names(res_complete$gd_params$lq$key_values) |> + expect_equal(c("e", + "m", + "n", + "r", + "s1", + "s2")) + + names(res_complete$gd_params$lq$validity) |> + expect_equal(c("is_normal", + "is_valid", + "headcount")) + + names(res_complete$gd_params$lb$key_values) |> + expect_equal(NULL) + + names(res_complete$data) |> + expect_equal(c("welfare", + "weight")) + + names(res_complete$selected_lorenz) |> + expect_equal(c( "for_dist", + "for_pov", + "use_lq_for_dist", + "use_lq_for_pov" )) + + names(res_complete$dist_stats) |> + expect_equal(c("polarization", + "lorenz")) + +}) + +test_that("pipgd_polarization calculates polarization as expected", { + + pol_benchmark_lb <- 0.242583101350098 + + pol_benchmark_lq <- 0.234947626306501 + + res_lq <- pipgd_polarization(welfare = welfare, + weight = weight, + lorenz = "lq") + res_lb <- pipgd_polarization(welfare = welfare, + weight = weight, + lorenz = "lb") + res_complete <- pipgd_polarization(welfare = welfare, + weight = weight, + complete = FALSE) + + res_lq$dist_stats$polarization |> + expect_equal(pol_benchmark_lq) + + res_lq$dist_stats$lorenz |> + expect_equal("lq") + + res_lb$dist_stats$lorenz |> + expect_equal("lb") + + res_lb$dist_stats$polarization |> + expect_equal(pol_benchmark_lb) + + attributes(res_lb$dist_stats$polarization) |> + expect_equal(NULL) + + attributes(res_lq$dist_stats$polarization) |> + expect_equal(NULL) + +}) + + + From bdeccab88ebc9a60c88da7c6b690e7a894c47aab Mon Sep 17 00:00:00 2001 From: zander-prinsloo Date: Tue, 13 Feb 2024 16:05:44 -0500 Subject: [PATCH 09/29] add pipster object to functions --- R/pipmd_pov.R | 45 ++++++++++++++++++++++++++++++++++++--------- 1 file changed, 36 insertions(+), 9 deletions(-) diff --git a/R/pipmd_pov.R b/R/pipmd_pov.R index 2092d83..621203f 100644 --- a/R/pipmd_pov.R +++ b/R/pipmd_pov.R @@ -17,14 +17,18 @@ #' @return numeric: Poverty headcount ratio #' @keywords internal pipmd_pov_headcount_nv <- function( - welfare , + pipster_object = NULL, + welfare = NULL, weight = rep(1, length = length(welfare)), povline = fmean(welfare, w = weight)*times_mean, times_mean = 1 ){ - # Defenses ------------- + if (!is.null(pipster_object)) { + welfare <- pipster_object$welfare |> unclass() + weight <- pipster_object$weight |> unclass() + } check_pipmd_pov() # Computations ------------ @@ -76,7 +80,8 @@ pipmd_pov_headcount_nv <- function( #' format = "atomic") #' pipmd_pov_headcount <- function( - welfare , + pipster_object = NULL, + welfare = NULL, weight = rep(1, length = length(welfare)), povline = fmean(welfare, w = weight)*times_mean, times_mean = 1, @@ -95,6 +100,7 @@ pipmd_pov_headcount <- function( SIMPLIFY = FALSE ) list_headcount <- pipmd_pov_headcount_v( + pipster_object = pipster_object, welfare = welfare, weight = weight, povline = povline @@ -137,12 +143,17 @@ pipmd_pov_headcount <- function( #' @return numeric: Poverty gap #' @keywords internal pipmd_pov_gap_nv <- function( - welfare , + pipster_object = NULL, + welfare = NULL, weight = rep(1, length = length(welfare)), povline = fmean(welfare, w = weight)*times_mean, times_mean = 1) { # Defenses ------------- + if (!is.null(pipster_object)) { + welfare <- pipster_object$welfare |> unclass() + weight <- pipster_object$weight |> unclass() + } check_pipmd_pov() # ____________________________________________________________________________ @@ -196,7 +207,8 @@ pipmd_pov_gap_nv <- function( #' format = "atomic") #' pipmd_pov_gap <- function( - welfare , + pipster_object = NULL, + welfare = NULL, weight = rep(1, length = length(welfare)), povline = fmean(welfare, w = weight)*times_mean, times_mean = 1, @@ -215,6 +227,7 @@ pipmd_pov_gap <- function( SIMPLIFY = FALSE ) list_pov_gap <- pipmd_pov_gap_v( + pipster_object = pipster_object, welfare = welfare, weight = weight, povline = povline @@ -255,12 +268,17 @@ pipmd_pov_gap <- function( #' @return numeric: Poverty severity #' @keywords internal pipmd_pov_severity_nv <- function( - welfare , + pipster_object = NULL, + welfare = NULL, weight = rep(1, length = length(welfare)), povline = fmean(welfare, w = weight)*times_mean, times_mean = 1) { # Defenses ------------- + if (!is.null(pipster_object)) { + welfare <- pipster_object$welfare |> unclass() + weight <- pipster_object$weight |> unclass() + } check_pipmd_pov() # ____________________________________________________________________________ @@ -314,7 +332,8 @@ pipmd_pov_severity_nv <- function( #' format = "atomic") #' pipmd_pov_severity <- function( - welfare , + pipster_object = NULL, + welfare = NULL, weight = rep(1, length = length(welfare)), povline = fmean(welfare, w = weight)*times_mean, times_mean = 1, @@ -333,6 +352,7 @@ pipmd_pov_severity <- function( SIMPLIFY = FALSE ) list_pov_severity <- pipmd_pov_severity_v( + pipster_object = pipster_object, welfare = welfare, weight = weight, povline = povline @@ -370,12 +390,17 @@ pipmd_pov_severity <- function( #' @return numeric: Watts index #' @keywords internal pipmd_watts_nv <- function( - welfare , + pipster_object = NULL, + welfare = NULL, weight = rep(1, length = length(welfare)), povline = fmean(welfare, w = weight)*times_mean, times_mean = 1 ){ # Defenses ------------- + if (!is.null(pipster_object)) { + welfare <- pipster_object$welfare |> unclass() + weight <- pipster_object$weight |> unclass() + } check_pipmd_pov() # ____________________________________________________________________________ @@ -428,7 +453,8 @@ pipmd_watts_nv <- function( #' format = "atomic") #' pipmd_watts <- function( - welfare , + pipster_object = NULL, + welfare = NULL, weight = rep(1, length = length(welfare)), povline = fmean(welfare, w = weight)*times_mean, times_mean = 1, @@ -447,6 +473,7 @@ pipmd_watts <- function( SIMPLIFY = FALSE ) list_watts <- pipmd_watts_v( + pipster_object = pipster_object, welfare = welfare, weight = weight, povline = povline From bac6462fb7b422b421e0968bbecdb8a13c035e7a Mon Sep 17 00:00:00 2001 From: zander-prinsloo Date: Tue, 13 Feb 2024 16:06:41 -0500 Subject: [PATCH 10/29] add pipster object to group data functions --- R/pipgd_pov.R | 407 ++++++++++++++++++++++++++------------------------ 1 file changed, 208 insertions(+), 199 deletions(-) diff --git a/R/pipgd_pov.R b/R/pipgd_pov.R index b3b68d5..9632620 100644 --- a/R/pipgd_pov.R +++ b/R/pipgd_pov.R @@ -13,39 +13,43 @@ #' @return numeric poverty headcount #' @keywords internal pipgd_pov_headcount_nv <- - function(params = NULL, - welfare = NULL, - weight = NULL, - mean = 1, - times_mean = 1, - popshare = NULL, - povline = ifelse(is.null(popshare), - mean*times_mean, - NA_real_), - lorenz = NULL, - complete = getOption("pipster.return_complete")){ + function(pipster_object = NULL, + params = NULL, + welfare = NULL, + weight = NULL, + mean = 1, + times_mean = 1, + popshare = NULL, + povline = ifelse(is.null(popshare), + mean*times_mean, + NA_real_), + lorenz = NULL, + complete = getOption("pipster.return_complete")){ # _________________________________________________________________ # Defenses #### pl <- as.list(environment()) check_pipgd_params(pl) - # ____________________________________________________ - # Computations #### - if (!is.null(welfare)) { - params <- pipgd_select_lorenz(welfare = welfare, - weight = weight, - complete = TRUE, - mean = mean, - popshare = popshare, - povline = povline) - } else { - params <- pipgd_select_lorenz(params = params, - complete = TRUE, - mean = mean, - popshare = popshare, - povline = povline) + # _________________________________________________________________ + # Params + # _________________________________________________________________ + if (!is.null(pipster_object)) { + welfare <- pipster_object$welfare |> unclass() + weight <- pipster_object$weight |> unclass() + } else if (is.null(welfare)) { + welfare <- params$data$welfare + weight <- params$data$weight } + params <- pipgd_select_lorenz(params = params, + welfare = welfare, + weight = weight, + mean = mean, + times_mean = times_mean, + popshare = popshare, + povline = povline, + complete = TRUE) + # # force selection of lorenz if (is.null(lorenz)) { lorenz <- params$selected_lorenz$for_pov @@ -116,18 +120,19 @@ pipgd_pov_headcount_nv <- #' complete = FALSE) #' pipgd_pov_headcount <- - function(params = NULL, - welfare = NULL, - weight = NULL, - mean = 1, - times_mean = 1, - popshare = NULL, - povline = ifelse(is.null(popshare), + function(pipster_object = NULL, + params = NULL, + welfare = NULL, + weight = NULL, + mean = 1, + times_mean = 1, + popshare = NULL, + povline = ifelse(is.null(popshare), mean*times_mean, NA_real_), - format = c("dt", "list", "atomic"), - lorenz = NULL, - complete = getOption("pipster.return_complete")) { + format = c("dt", "list", "atomic"), + lorenz = NULL, + complete = getOption("pipster.return_complete")) { format <- match.arg(format) @@ -138,15 +143,16 @@ pipgd_pov_headcount <- SIMPLIFY = FALSE) - ld <- pipgd_pov_headcount_v(welfare = welfare, - weight = weight, - params = params, - povline = povline, - popshare = popshare, - complete = complete, - lorenz = lorenz, - mean = mean, - times_mean = times_mean) + ld <- pipgd_pov_headcount_v(pipster_object = pipster_object, + welfare = welfare, + weight = weight, + params = params, + povline = povline, + popshare = popshare, + complete = complete, + lorenz = lorenz, + mean = mean, + times_mean = times_mean) # ____________________________________________________ # Return #### @@ -167,40 +173,45 @@ pipgd_pov_headcount <- #' #' @return numeric poverty gap value #' @keywords internal -pipgd_pov_gap_nv <- function(params = NULL, - welfare = NULL, - weight = NULL, - mean = 1, - times_mean = 1, - popshare = NULL, - povline = ifelse(is.null(popshare), +pipgd_pov_gap_nv <- function(pipster_object = NULL, + params = NULL, + welfare = NULL, + weight = NULL, + mean = 1, + times_mean = 1, + popshare = NULL, + povline = ifelse(is.null(popshare), mean*times_mean, NA_real_), - lorenz = NULL, - complete = getOption("pipster.return_complete") + lorenz = NULL, + complete = getOption("pipster.return_complete") ){ # _________________________________________________________________ # Defenses pl <- as.list(environment()) - check_pipgd_params(pl) - # ____________________________________________________ - # Compute params - if (!is.null(welfare)) { - params <- pipgd_pov_headcount_nv(welfare = welfare, - weight = weight, - complete = TRUE, - popshare = popshare, - povline = povline, - lorenz = lorenz) - } else { - params <- pipgd_pov_headcount_nv(params = params, - complete = TRUE, - popshare = popshare, - povline = povline, - lorenz = lorenz) - } + # _________________________________________________________________ + # Params + # _________________________________________________________________ + params <- pipgd_pov_headcount_nv(pipster_object = pipster_object, + welfare = welfare, + weight = weight, + params = params, + mean = mean, + times_mean = times_mean, + popshare = popshare, + povline = povline, + complete = TRUE) + # validate_params(pipster_object = pipster_object, + # welfare = welfare, + # weight = weight, + # params = params, + # mean = mean, + # times_mean = times_mean, + # popshare = popshare, + # povline = povline) + check_pipgd_params(pl) # Select Lorenz ------------------------------------------------------- if (is.null(lorenz)) { @@ -298,18 +309,19 @@ pipgd_pov_gap_nv <- function(params = NULL, #' format = "atomic", #' complete = FALSE) #' -pipgd_pov_gap <- function(params = NULL, - welfare = NULL, - weight = NULL, - mean = 1, - times_mean = 1, - popshare = NULL, - povline = ifelse(is.null(popshare), +pipgd_pov_gap <- function(pipster_object = NULL, + params = NULL, + welfare = NULL, + weight = NULL, + mean = 1, + times_mean = 1, + popshare = NULL, + povline = ifelse(is.null(popshare), mean*times_mean, NA_real_), - format = c("dt", "list", "atomic"), - lorenz = NULL, - complete = getOption("pipster.return_complete")) { + format = c("dt", "list", "atomic"), + lorenz = NULL, + complete = getOption("pipster.return_complete")) { format <- match.arg(format) @@ -319,15 +331,16 @@ pipgd_pov_gap <- function(params = NULL, vectorize.args = "povline", SIMPLIFY = FALSE) - ld <- pipgd_pov_gap_v(welfare = welfare, - weight = weight, - params = params, - popshare = popshare, - povline = povline, - complete = complete, - lorenz = lorenz, - mean = mean, - times_mean = times_mean) + ld <- pipgd_pov_gap_v(pipster_object = pipster_object, + welfare = welfare, + weight = weight, + params = params, + popshare = popshare, + povline = povline, + complete = complete, + lorenz = lorenz, + mean = mean, + times_mean = times_mean) # ____________________________________________________ # Return #### @@ -356,18 +369,19 @@ pipgd_pov_gap <- function(params = NULL, #' also returns all params. #' @keywords internal pipgd_pov_severity_nv <- function( - params = NULL, - welfare = NULL, - weight = NULL, - mean = 1, - times_mean = 1, - popshare = NULL, - povline = ifelse(is.null(popshare), - mean*times_mean, - NA_real_), - lorenz = NULL, - pov_gap = NULL, - complete = getOption("pipster.return_complete") + pipster_object = pipster_object, + params = NULL, + welfare = NULL, + weight = NULL, + mean = 1, + times_mean = 1, + popshare = NULL, + povline = ifelse(is.null(popshare), + mean*times_mean, + NA_real_), + lorenz = NULL, + pov_gap = NULL, + complete = getOption("pipster.return_complete") ){ # __________________________________________________________________________ # Defenses --------------------------------------------------------------- @@ -378,8 +392,9 @@ pipgd_pov_severity_nv <- function( # Computations ----------------------------------------------------------- if (!is.null(pov_gap)) { if (!all(c("pov_gap", "lorenz") %in% names(pov_gap$pov_stats))) { - stop("argument `pov_gap` should be the output of - `pipster:::pipgd_pov_gap_nv`, else leave `pov_gap = NULL`") + cli::cli_abort("argument `pov_gap` should be the output of + `pipster:::pipgd_pov_gap_nv`, + else leave `pov_gap = NULL`") } else { params <- pov_gap } @@ -387,24 +402,26 @@ pipgd_pov_severity_nv <- function( if (!is.null(welfare)) { params <- pipgd_pov_gap_nv( - welfare = welfare, - weight = weight, - complete = TRUE, - mean = mean, - times_mean = times_mean, - popshare = popshare, - povline = povline, - lorenz = lorenz + pipster_object = pipster_object, + welfare = welfare, + weight = weight, + complete = TRUE, + mean = mean, + times_mean = times_mean, + popshare = popshare, + povline = povline, + lorenz = lorenz ) } else { params <- pipgd_pov_gap_nv( - params = params, - complete = TRUE, - mean = mean, - times_mean = times_mean, - popshare = popshare, - povline = povline, - lorenz = lorenz + pipster_object = pipster_object, + params = params, + complete = TRUE, + mean = mean, + times_mean = times_mean, + popshare = popshare, + povline = povline, + lorenz = lorenz ) } # Select Lorenz ------------------------------------------------------- @@ -529,19 +546,20 @@ pipgd_pov_severity_nv <- function( #' complete = FALSE) #' pipgd_pov_severity <- function( - params = NULL, - welfare = NULL, - weight = NULL, - mean = 1, - times_mean = 1, - popshare = NULL, - povline = ifelse(is.null(popshare), - mean*times_mean, - NA_real_), - format = c("dt", "list", "atomic"), - lorenz = NULL, - pov_gap = NULL, - complete = getOption("pipster.return_complete") + pipster_object = NULL, + params = NULL, + welfare = NULL, + weight = NULL, + mean = 1, + times_mean = 1, + popshare = NULL, + povline = ifelse(is.null(popshare), + mean*times_mean, + NA_real_), + format = c("dt", "list", "atomic"), + lorenz = NULL, + pov_gap = NULL, + complete = getOption("pipster.return_complete") ) { # ____________________________________________________________________________ @@ -564,16 +582,17 @@ pipgd_pov_severity <- function( SIMPLIFY = FALSE ) list_povsev <- pipgd_pov_severity_v( - params = params, - welfare = welfare, - weight = weight, - mean = mean, - times_mean = times_mean, - popshare = popshare, - povline = povline, - lorenz = lorenz, - pov_gap = pov_gap, - complete = complete + pipster_object = pipster_object, + params = params, + welfare = welfare, + weight = weight, + mean = mean, + times_mean = times_mean, + popshare = popshare, + povline = povline, + lorenz = lorenz, + pov_gap = pov_gap, + complete = complete ) # ____________________________________________________________________________ @@ -609,47 +628,36 @@ pipgd_pov_severity <- function( #' #' @keywords internal pipgd_watts_nv <- function( - params = NULL, - welfare = NULL, - weight = NULL, - mean = 1, - times_mean = 1, - popshare = NULL, - povline = ifelse(is.null(popshare), - mean*times_mean, - NA_real_), - lorenz = NULL, - complete = getOption("pipster.return_complete") + pipster_object = pipster_object, + params = NULL, + welfare = NULL, + weight = NULL, + mean = 1, + times_mean = 1, + popshare = NULL, + povline = ifelse(is.null(popshare), + mean*times_mean, + NA_real_), + lorenz = NULL, + complete = getOption("pipster.return_complete") ){ # __________________________________________________________________________ # Defenses --------------------------------------------------------------- pl <- as.list(environment()) check_pipgd_params(pl) - # __________________________________________________________________________ - # Computations ----------------------------------------------------------- - if (!is.null(welfare)) { - params <- pipgd_pov_headcount_nv( - welfare = welfare, - weight = weight, - complete = TRUE, - mean = mean, - popshare = popshare, - povline = povline, - times_mean = times_mean, - lorenz = lorenz - ) - } else { - params <- pipgd_pov_headcount_nv( - params = params, - complete = TRUE, - mean = mean, - popshare = popshare, - povline = povline, - times_mean = times_mean, - lorenz = lorenz - ) - } + # _________________________________________________________________ + # Params + # _________________________________________________________________ + params <- pipgd_pov_headcount_nv(pipster_object = pipster_object, + welfare = welfare, + weight = weight, + params = params, + mean = mean, + times_mean = times_mean, + popshare = popshare, + povline = povline, + complete = TRUE) # Select Lorenz ------------------------------------------------------- if (is.null(lorenz)) { @@ -658,7 +666,6 @@ pipgd_watts_nv <- function( match.arg(lorenz, c("lq", "lb")) } - # Ensure `povline` exists ----------- if (!is.null(popshare)) { derive_ <- @@ -752,18 +759,19 @@ pipgd_watts_nv <- function( #' times_mean = 1.5) #' pipgd_watts <- function( - params = NULL, - welfare = NULL, - weight = NULL, - mean = 1, - times_mean = 1, - popshare = NULL, - povline = ifelse(is.null(popshare), - mean*times_mean, - NA_real_), - format = c("dt", "list", "atomic"), - lorenz = NULL, - complete = getOption("pipster.return_complete") + pipster_object = pipster_object, + params = NULL, + welfare = NULL, + weight = NULL, + mean = 1, + times_mean = 1, + popshare = NULL, + povline = ifelse(is.null(popshare), + mean*times_mean, + NA_real_), + format = c("dt", "list", "atomic"), + lorenz = NULL, + complete = getOption("pipster.return_complete") ) { # ____________________________________________________________________________ @@ -778,15 +786,16 @@ pipgd_watts <- function( SIMPLIFY = FALSE ) list_watts <- pipgd_watts_v( - params = params, - welfare = welfare, - weight = weight, - mean = mean, - times_mean = times_mean, - popshare = popshare, - povline = povline, - lorenz = lorenz, - complete = complete + pipster_object = pipster_object, + params = params, + welfare = welfare, + weight = weight, + mean = mean, + times_mean = times_mean, + popshare = popshare, + povline = povline, + lorenz = lorenz, + complete = complete ) # ____________________________________________________________________________ From 41dc13e51875a48e87a2f5eb8b8cc1375eaddf60 Mon Sep 17 00:00:00 2001 From: zander-prinsloo Date: Tue, 13 Feb 2024 16:07:15 -0500 Subject: [PATCH 11/29] modify lorenz parameter calc and error message --- R/pipgd_lorenz.R | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/R/pipgd_lorenz.R b/R/pipgd_lorenz.R index 92bc3e1..0d7ea1c 100644 --- a/R/pipgd_lorenz.R +++ b/R/pipgd_lorenz.R @@ -60,9 +60,11 @@ pipgd_validate_lorenz <- # Computations #### if (!is.null(welfare) & !is.null(weight)) { params <- pipgd_params(welfare = welfare, - weight = weight) + weight = weight, + mean = mean) } else if (is.null(params$gd_params$lq$reg_results$coef)) { - stop( + + cli::cli_abort( "Either `welfare` and `weights` should be specified or `params` should be output from `pipster::pipgd_params()`" ) From 458f163f2a4742f0c45c8e5b4cef7899e47d2a84 Mon Sep 17 00:00:00 2001 From: zander-prinsloo Date: Tue, 13 Feb 2024 16:07:35 -0500 Subject: [PATCH 12/29] call full args --- R/pipgd_dist.R | 32 ++++++++++++++++++++++++-------- 1 file changed, 24 insertions(+), 8 deletions(-) diff --git a/R/pipgd_dist.R b/R/pipgd_dist.R index 6acb635..f8aaa85 100644 --- a/R/pipgd_dist.R +++ b/R/pipgd_dist.R @@ -79,7 +79,8 @@ pipgd_welfare_share_at <- function( params <- validate_params(pipster_object = pipster_object, welfare = welfare, weight = weight, - params = params) + params = params, + popshare = popshare) if (is.null(lorenz)) { lorenz <- params$selected_lorenz$for_dist @@ -183,7 +184,8 @@ pipgd_quantile_welfare_share <- params <- validate_params(pipster_object = pipster_object, welfare = welfare, weight = weight, - params = params) + params = params, + popshare = popshare) if (is.null(lorenz)) { lorenz <- params$selected_lorenz$for_dist @@ -294,7 +296,9 @@ pipgd_quantile <- params <- validate_params(pipster_object = pipster_object, welfare = welfare, weight = weight, - params = params) + params = params, + popshare = popshare, + mean = mean) if (is.null(lorenz)) { lorenz <- params$selected_lorenz$for_dist @@ -521,21 +525,33 @@ validate_params <- function( pipster_object, welfare, weight, - params + params, + mean = 1, + times_mean = 1, + popshare = NULL, + povline = ifelse(is.null(popshare), mean * times_mean, NA_real_) ){ if (!is.null(pipster_object)) { params <- pipster_object$params - + class(params) <- "pipgd_params" } else if (!is.null(welfare)) { params <- pipgd_select_lorenz(welfare = welfare, - weight = weight, - complete = TRUE) + weight = weight, + complete = TRUE, + mean = mean, + times_mean = times_mean, + popshare = popshare, + povline = povline) } else { params <- pipgd_select_lorenz(welfare = params$data$welfare, weight = params$data$weight, - complete = TRUE) + complete = TRUE, + mean = mean, + times_mean = times_mean, + popshare = popshare, + povline = povline) } params From ac65f7a89ac3d7e26eb585e493d5aa72a1cecf1e Mon Sep 17 00:00:00 2001 From: zander-prinsloo Date: Tue, 13 Feb 2024 16:08:13 -0500 Subject: [PATCH 13/29] S3 methods poverty indicators --- R/get_pov.R | 417 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 417 insertions(+) create mode 100644 R/get_pov.R diff --git a/R/get_pov.R b/R/get_pov.R new file mode 100644 index 0000000..2cdac5a --- /dev/null +++ b/R/get_pov.R @@ -0,0 +1,417 @@ + + +# Headcount ------------------------------------ + + +#' Calculate poverty headcount +#' +#' This is a generic function to compute the +#' poverty headcount ratio - i.e. FGT 0. +#' +#' @param pipster_object pipster object created using [create_pipster_object] +#' @inheritParams pipmd_pov_headcount +#' +#' @return list +#' @export +get_pov_headcount <- + function(pipster_object, + povline, + ... ) { + + welfare <- pipster_object$welfare + + UseMethod("get_pov_headcount", + object = welfare) + } + + + +#' Calculate poverty headcount for group data +#' +#' This is a method to compute poverty headcount on group data. +#' Requires a pipster object of class `pipster_gd` (grouped data object). +#' This is a wrapper over [pipgd_pov_headcount], which should be viewed +#' for more detail. +#' +#' @inheritParams get_pov_headcount +#' @param ... additional arguments passed to [pipgd_pov_headcount] +#' +#' @return list +#' @export +get_pov_headcount.pipster_gd <- + function(pipster_object, + povline, + ...) { + + # Computations + res <- + pipgd_pov_headcount(pipster_object = pipster_object, + povline = povline, + ...) + + # Format + res + + } + + + +#' Calculate poverty headcount for micro data +#' +#' This is a method to compute poverty headcount on micro data. +#' Requires a pipster object of class `pipster_md` (grouped data object). +#' This is a wrapper over [pipmd_pov_headcount], which should be viewed +#' for more detail. +#' +#' @inheritParams get_pov_headcount +#' @param ... additional arguments passed to [pipmd_pov_headcount] +#' +#' @return list +#' @export +get_pov_headcount.pipster_md <- + function(pipster_object, + povline, + ...) { + + pipmd_pov_headcount(pipster_object = pipster_object, + povline = povline, + format = "list", + ...) + } + + +#' Calculate poverty headcount default method +#' +#' This default S3 method returns an error when called +#' +#' @inheritParams get_pov_headcount +#' @param ... additional arguments +#' +#' @return list +#' @export +get_pov_headcount.default <- + function(pipster_object, + ...) { + + cli::cli_abort("No default exist. Please check object class.") + } + + + + + + + + + + + + + + + + + + + + + + + + + +# Poverty Gap ------------------------------------ + + +#' Calculate poverty gap +#' +#' This is a generic function to compute the +#' poverty gap - i.e. FGT 1. +#' +#' @param pipster_object pipster object created using [create_pipster_object] +#' @inheritParams pipmd_pov_gap +#' +#' @return list +#' @export +get_pov_gap <- + function(pipster_object, + povline, + ... ) { + + welfare <- pipster_object$welfare + + UseMethod("get_pov_gap", + object = welfare) + } + + + +#' Calculate poverty gap for group data +#' +#' This is a method to compute poverty gap on group data. +#' Requires a pipster object of class `pipster_gd` (grouped data object). +#' This is a wrapper over [pipgd_pov_gap], which should be viewed +#' for more detail. +#' +#' @inheritParams get_pov_gap +#' @param ... additional arguments passed to [pipgd_pov_gap] +#' +#' @return list +#' @export +get_pov_gap.pipster_gd <- + function(pipster_object, + povline, + ...) { + + # Computations + res <- + pipgd_pov_gap(pipster_object = pipster_object, + povline = povline, + ...) + + # Format + res + + } + + + +#' Calculate poverty gap for micro data +#' +#' This is a method to compute poverty gap on micro data. +#' Requires a pipster object of class `pipster_md` (micro data object). +#' This is a wrapper over [pipmd_pov_gap], which should be viewed +#' for more detail. +#' +#' @inheritParams get_pov_gap +#' @param ... additional arguments passed to [pipmd_pov_gap] +#' +#' @return list +#' @export +get_pov_gap.pipster_md <- + function(pipster_object, + povline, + ...) { + + pipmd_pov_gap(pipster_object = pipster_object, + povline = povline, + format = "list", + ...) + } + + +#' Calculate poverty gap default method +#' +#' This default S3 method returns an error when called +#' +#' @inheritParams get_pov_gap +#' @param ... additional arguments +#' +#' @return list +#' @export +get_pov_gap.default <- + function(pipster_object, + ...) { + + cli::cli_abort("No default exist. Please check object class.") + } + + + + +# Poverty Severity ------------------------------------ + + +#' Calculate poverty severity +#' +#' This is a generic function to compute the +#' poverty severity - i.e. FGT 2. +#' +#' @param pipster_object pipster object created using [create_pipster_object] +#' @inheritParams pipmd_pov_severity +#' +#' @return list +#' @export +get_pov_severity <- + function(pipster_object, + povline, + ... ) { + + welfare <- pipster_object$welfare + + UseMethod("get_pov_severity", + object = welfare) + } + + + +#' Calculate poverty severity for group data +#' +#' This is a method to compute poverty severity on group data. +#' Requires a pipster object of class `pipster_gd` (grouped data object). +#' This is a wrapper over [pipgd_pov_severity], which should be viewed +#' for more detail. +#' +#' @inheritParams get_pov_severity +#' @param ... additional arguments passed to [pipgd_pov_severity] +#' +#' @return list +#' @export +get_pov_severity.pipster_gd <- + function(pipster_object, + povline, + ...) { + + # Computations + res <- + pipgd_pov_severity(pipster_object = pipster_object, + povline = povline, + ...) + + # Format + res + + } + + + +#' Calculate poverty severity for micro data +#' +#' This is a method to compute poverty severity on micro data. +#' Requires a pipster object of class `pipster_md` (micro data object). +#' This is a wrapper over [pipmd_pov_severity], which should be viewed +#' for more detail. +#' +#' @inheritParams get_pov_severity +#' @param ... additional arguments passed to [pipmd_pov_severity] +#' +#' @return list +#' @export +get_pov_severity.pipster_md <- + function(pipster_object, + povline, + ...) { + + pipmd_pov_gap(pipster_object = pipster_object, + povline = povline, + format = "list", + ...) + } + + +#' Calculate poverty severity default method +#' +#' This default S3 method returns an error when called +#' +#' @inheritParams get_pov_severity +#' @param ... additional arguments +#' +#' @return list +#' @export +get_pov_severity.default <- + function(pipster_object, + ...) { + + cli::cli_abort("No default exist. Please check object class.") + } + + + + +# Watts ------------------------------------ + + +#' Calculate Watts poverty index +#' +#' This is a generic function to compute the +#' Watts poverty index +#' +#' @param pipster_object pipster object created using [create_pipster_object] +#' @inheritParams pipmd_watts +#' +#' @return list +#' @export +get_watts <- + function(pipster_object, + povline, + ... ) { + + welfare <- pipster_object$welfare + + UseMethod("get_watts", + object = welfare) + } + + + +#' Calculate Watts poverty index for group data +#' +#' This is a method to compute Watts poverty indexon group data. +#' Requires a pipster object of class `pipster_gd` (grouped data object). +#' This is a wrapper over [pipgd_watts], which should be viewed +#' for more detail. +#' +#' @inheritParams get_watts +#' @param ... additional arguments passed to [pipgd_watts] +#' +#' @return list +#' @export +get_watts.pipster_gd <- + function(pipster_object, + povline, + ...) { + + # Computations + res <- + pipgd_watts(pipster_object = pipster_object, + povline = povline, + ...) + + # Format + res + + } + + + +#' Calculate Watts poverty index for micro data +#' +#' This is a method to compute Watts poverty index on micro data. +#' Requires a pipster object of class `pipster_md` (micro data object). +#' This is a wrapper over [pipmd_watts], which should be viewed +#' for more detail. +#' +#' @inheritParams get_watts +#' @param ... additional arguments passed to [pipmd_watts] +#' +#' @return list +#' @export +get_watts.pipster_md <- + function(pipster_object, + povline, + ...) { + + pipmd_watts(pipster_object = pipster_object, + povline = povline, + format = "list", + ...) + } + + +#' Calculate Watts poverty index default method +#' +#' This default S3 method returns an error when called +#' +#' @inheritParams get_watts +#' @param ... additional arguments +#' +#' @return list +#' @export +get_wattsy.default <- + function(pipster_object, + ...) { + + cli::cli_abort("No default exist. Please check object class.") + } + + From f1027473dac5207506c279b346557bd1645291f4 Mon Sep 17 00:00:00 2001 From: zander-prinsloo Date: Tue, 13 Feb 2024 16:09:40 -0500 Subject: [PATCH 14/29] correct documentation --- R/get_dist.R | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/R/get_dist.R b/R/get_dist.R index e6fcadf..91f1413 100644 --- a/R/get_dist.R +++ b/R/get_dist.R @@ -530,7 +530,7 @@ get_polarization.pipster_md <- } -#' Gini coefficient S3 default +#' Wolfson polarization index S3 default #' #' This default S3 method returns an error when called #' @@ -582,7 +582,7 @@ get_mld <- #' for more detail. #' #' @inheritParams get_mld -#' @param ... additional arguments passed to pipgd_mld +#' @param ... additional arguments passed to [pipgd_mld] #' #' @return list #' @export @@ -603,15 +603,15 @@ get_mld.pipster_gd <- } -#' Wolfson polarization index +#' Mean Log Deviation (MLD) for micro data #' -#' This is a method to compute the Wolfson polarization index on micro data. -#' Requires a pipster object of class `pipster_md` (micro data object). -#' This is a wrapper over [pipmd_polarization], which should be viewed +#' This is a method to compute the MLD on group data. +#' Requires a pipster object of class `pipster_md` (grouped data object). +#' This is a wrapper over [pipmd_mld], which should be viewed #' for more detail. #' #' @inheritParams get_mld -#' @param ... additional arguments passed to [pipmd_polarization] +#' @param ... additional arguments passed to [pipmd_mld] #' #' @return list #' @export @@ -625,7 +625,7 @@ get_mld.pipster_md <- } -#' Gini coefficient S3 default +#' MLD S3 default #' #' This default S3 method returns an error when called #' From 65e26bf1e3139a89fd646065c617b53bdacb3e30 Mon Sep 17 00:00:00 2001 From: zander-prinsloo Date: Tue, 13 Feb 2024 16:11:29 -0500 Subject: [PATCH 15/29] fix typos, make small changes --- R/get_pov.R | 2 +- R/identify_pip_type.R | 3 +-- 2 files changed, 2 insertions(+), 3 deletions(-) diff --git a/R/get_pov.R b/R/get_pov.R index 2cdac5a..e1a7a4b 100644 --- a/R/get_pov.R +++ b/R/get_pov.R @@ -407,7 +407,7 @@ get_watts.pipster_md <- #' #' @return list #' @export -get_wattsy.default <- +get_watts.default <- function(pipster_object, ...) { diff --git a/R/identify_pip_type.R b/R/identify_pip_type.R index ceb6e27..0816ee5 100644 --- a/R/identify_pip_type.R +++ b/R/identify_pip_type.R @@ -79,7 +79,7 @@ identify_pip_type <- function(welfare, if (verbose) { cli::cli_alert_warning("vectors not sorted") } - o <- order(welfare) + o <- order(welfare) welfare <- welfare[o] weight <- weight[o] } @@ -109,7 +109,6 @@ identify_pip_type <- function(welfare, weight_is_cum <- is_cumulative(weight) } - #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ## First identification of group data -------- From dc90ab607290497f8671bac7114d9e2ec1cd027b Mon Sep 17 00:00:00 2001 From: zander-prinsloo Date: Tue, 13 Feb 2024 16:13:16 -0500 Subject: [PATCH 16/29] document --- NAMESPACE | 79 ++++++++++++++++++++ R/pipster.R | 38 ++++++++++ man/create_pipster_object.Rd | 35 +++++++++ man/default_warning_message.Rd | 21 ++++++ man/get_gini.Rd | 17 +++++ man/get_gini.default.Rd | 19 +++++ man/get_gini.pipster_gd.Rd | 22 ++++++ man/get_gini.pipster_md.Rd | 22 ++++++ man/get_mld.Rd | 18 +++++ man/get_mld.default.Rd | 19 +++++ man/get_mld.pipster_gd.Rd | 22 ++++++ man/get_mld.pipster_md.Rd | 22 ++++++ man/get_polarization.Rd | 17 +++++ man/get_polarization.default.Rd | 19 +++++ man/get_polarization.pipster_gd.Rd | 22 ++++++ man/get_polarization.pipster_md.Rd | 22 ++++++ man/get_pov_gap.Rd | 20 +++++ man/get_pov_gap.default.Rd | 19 +++++ man/get_pov_gap.pipster_gd.Rd | 24 ++++++ man/get_pov_gap.pipster_md.Rd | 24 ++++++ man/get_pov_headcount.Rd | 20 +++++ man/get_pov_headcount.default.Rd | 19 +++++ man/get_pov_headcount.pipster_gd.Rd | 24 ++++++ man/get_pov_headcount.pipster_md.Rd | 24 ++++++ man/get_pov_severity.Rd | 20 +++++ man/get_pov_severity.default.Rd | 19 +++++ man/get_pov_severity.pipster_gd.Rd | 24 ++++++ man/get_pov_severity.pipster_md.Rd | 24 ++++++ man/get_quantile.Rd | 27 +++++++ man/get_quantile.default.Rd | 28 +++++++ man/get_quantile.pipster_gd.Rd | 31 ++++++++ man/get_quantile.pipster_md.Rd | 30 ++++++++ man/get_quantile_welfare_share.Rd | 31 ++++++++ man/get_quantile_welfare_share.default.Rd | 28 +++++++ man/get_quantile_welfare_share.pipster_gd.Rd | 38 ++++++++++ man/get_quantile_welfare_share.pipster_md.Rd | 38 ++++++++++ man/get_watts.Rd | 20 +++++ man/get_watts.default.Rd | 19 +++++ man/get_watts.pipster_gd.Rd | 24 ++++++ man/get_watts.pipster_md.Rd | 24 ++++++ man/get_welfare_share_at.Rd | 29 +++++++ man/get_welfare_share_at.default.Rd | 28 +++++++ man/get_welfare_share_at.pipster_gd.Rd | 36 +++++++++ man/get_welfare_share_at.pipster_md.Rd | 33 ++++++++ man/pipgd_gini.Rd | 3 + man/pipgd_mld.Rd | 3 + man/pipgd_pov_gap.Rd | 3 + man/pipgd_pov_gap_nv.Rd | 3 + man/pipgd_pov_headcount.Rd | 3 + man/pipgd_pov_headcount_nv.Rd | 3 + man/pipgd_pov_severity.Rd | 3 + man/pipgd_pov_severity_nv.Rd | 3 + man/pipgd_quantile.Rd | 3 + man/pipgd_quantile_welfare_share.Rd | 3 + man/pipgd_watts.Rd | 3 + man/pipgd_watts_nv.Rd | 3 + man/pipgd_welfare_share_at.Rd | 3 + man/pipmd_gini.Rd | 3 + man/pipmd_mld.Rd | 3 + man/pipmd_polarization.Rd | 3 + man/pipmd_pov_gap.Rd | 3 +- man/pipmd_pov_gap_nv.Rd | 3 +- man/pipmd_pov_headcount.Rd | 3 +- man/pipmd_pov_headcount_nv.Rd | 3 +- man/pipmd_pov_severity.Rd | 3 +- man/pipmd_pov_severity_nv.Rd | 3 +- man/pipmd_quantile.Rd | 5 +- man/pipmd_quantile_welfare_share.Rd | 3 + man/pipmd_watts.Rd | 3 +- man/pipmd_watts_nv.Rd | 3 +- man/pipmd_welfare_share_at.Rd | 5 +- man/pipster.Rd | 12 ++- man/pipster_gd.Rd | 30 ++++++++ man/pipster_md.Rd | 30 ++++++++ man/validate_params.Rd | 35 +++++++++ 75 files changed, 1319 insertions(+), 12 deletions(-) create mode 100644 R/pipster.R create mode 100644 man/create_pipster_object.Rd create mode 100644 man/default_warning_message.Rd create mode 100644 man/get_gini.Rd create mode 100644 man/get_gini.default.Rd create mode 100644 man/get_gini.pipster_gd.Rd create mode 100644 man/get_gini.pipster_md.Rd create mode 100644 man/get_mld.Rd create mode 100644 man/get_mld.default.Rd create mode 100644 man/get_mld.pipster_gd.Rd create mode 100644 man/get_mld.pipster_md.Rd create mode 100644 man/get_polarization.Rd create mode 100644 man/get_polarization.default.Rd create mode 100644 man/get_polarization.pipster_gd.Rd create mode 100644 man/get_polarization.pipster_md.Rd create mode 100644 man/get_pov_gap.Rd create mode 100644 man/get_pov_gap.default.Rd create mode 100644 man/get_pov_gap.pipster_gd.Rd create mode 100644 man/get_pov_gap.pipster_md.Rd create mode 100644 man/get_pov_headcount.Rd create mode 100644 man/get_pov_headcount.default.Rd create mode 100644 man/get_pov_headcount.pipster_gd.Rd create mode 100644 man/get_pov_headcount.pipster_md.Rd create mode 100644 man/get_pov_severity.Rd create mode 100644 man/get_pov_severity.default.Rd create mode 100644 man/get_pov_severity.pipster_gd.Rd create mode 100644 man/get_pov_severity.pipster_md.Rd create mode 100644 man/get_quantile.Rd create mode 100644 man/get_quantile.default.Rd create mode 100644 man/get_quantile.pipster_gd.Rd create mode 100644 man/get_quantile.pipster_md.Rd create mode 100644 man/get_quantile_welfare_share.Rd create mode 100644 man/get_quantile_welfare_share.default.Rd create mode 100644 man/get_quantile_welfare_share.pipster_gd.Rd create mode 100644 man/get_quantile_welfare_share.pipster_md.Rd create mode 100644 man/get_watts.Rd create mode 100644 man/get_watts.default.Rd create mode 100644 man/get_watts.pipster_gd.Rd create mode 100644 man/get_watts.pipster_md.Rd create mode 100644 man/get_welfare_share_at.Rd create mode 100644 man/get_welfare_share_at.default.Rd create mode 100644 man/get_welfare_share_at.pipster_gd.Rd create mode 100644 man/get_welfare_share_at.pipster_md.Rd create mode 100644 man/pipster_gd.Rd create mode 100644 man/pipster_md.Rd create mode 100644 man/validate_params.Rd diff --git a/NAMESPACE b/NAMESPACE index 269937c..d178eb3 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,7 +1,83 @@ # Generated by roxygen2: do not edit by hand +S3method(format,pipster_gd) +S3method(format,pipster_md) +S3method(get_gini,default) +S3method(get_gini,pipster_gd) +S3method(get_gini,pipster_md) +S3method(get_mld,default) +S3method(get_mld,pipster_gd) +S3method(get_mld,pipster_md) +S3method(get_polarization,default) +S3method(get_polarization,pipster_gd) +S3method(get_polarization,pipster_md) +S3method(get_pov_gap,default) +S3method(get_pov_gap,pipster_gd) +S3method(get_pov_gap,pipster_md) +S3method(get_pov_headcount,default) +S3method(get_pov_headcount,pipster_gd) +S3method(get_pov_headcount,pipster_md) +S3method(get_pov_severity,default) +S3method(get_pov_severity,pipster_gd) +S3method(get_pov_severity,pipster_md) +S3method(get_quantile,default) +S3method(get_quantile,pipster_gd) +S3method(get_quantile,pipster_md) +S3method(get_quantile_welfare_share,default) +S3method(get_quantile_welfare_share,pipster_gd) +S3method(get_quantile_welfare_share,pipster_md) +S3method(get_watts,default) +S3method(get_watts,pipster_gd) +S3method(get_watts,pipster_md) +S3method(get_welfare_share_at,default) +S3method(get_welfare_share_at,pipster_gd) +S3method(get_welfare_share_at,pipster_md) +S3method(vec_arith,pipster_gd) +S3method(vec_arith,pipster_md) +S3method(vec_arith.numeric,pipster_gd) +S3method(vec_arith.numeric,pipster_md) +S3method(vec_arith.pipster_gd,default) +S3method(vec_arith.pipster_gd,numeric) +S3method(vec_arith.pipster_gd,pipster_gd) +S3method(vec_arith.pipster_md,default) +S3method(vec_arith.pipster_md,numeric) +S3method(vec_arith.pipster_md,pipster_md) +S3method(vec_cast,double.pipster_gd) +S3method(vec_cast,double.pipster_md) +S3method(vec_cast,pipster_gd.double) +S3method(vec_cast,pipster_gd.pipster_gd) +S3method(vec_cast,pipster_md.double) +S3method(vec_cast,pipster_md.pipster_md) +S3method(vec_math,pipster_gd) +S3method(vec_math,pipster_md) +S3method(vec_ptype2,double.pipster_gd) +S3method(vec_ptype2,double.pipster_md) +S3method(vec_ptype2,integer.pipster_gd) +S3method(vec_ptype2,integer.pipster_md) +S3method(vec_ptype2,pipster_gd.double) +S3method(vec_ptype2,pipster_gd.integer) +S3method(vec_ptype2,pipster_gd.pipster_gd) +S3method(vec_ptype2,pipster_md.double) +S3method(vec_ptype2,pipster_md.integer) +S3method(vec_ptype2,pipster_md.pipster_md) +S3method(vec_ptype_abbr,pipster_gd) +S3method(vec_ptype_abbr,pipster_md) +export(as_percent) export(as_pip) +export(create_pipster_object) +export(get_gini) +export(get_mld) +export(get_polarization) +export(get_pov_gap) +export(get_pov_headcount) +export(get_pov_severity) +export(get_quantile) +export(get_quantile_welfare_share) +export(get_watts) +export(get_welfare_share_at) export(identify_pip_type) +export(is_pipster_gd) +export(is_pipster_md) export(pipgd_gini) export(pipgd_lorenz_curve) export(pipgd_mld) @@ -25,4 +101,7 @@ export(pipmd_quantile) export(pipmd_quantile_welfare_share) export(pipmd_watts) export(pipmd_welfare_share_at) +export(pipster_gd) +export(pipster_md) import(collapse) +import(vctrs) diff --git a/R/pipster.R b/R/pipster.R new file mode 100644 index 0000000..936a252 --- /dev/null +++ b/R/pipster.R @@ -0,0 +1,38 @@ +#' pipster: Poverty and Inequality methodology of WB methodology +#' +#' A higher-level package to estimate socioeconomic indicators on poverty and +#' inequality using the methodology by the World Bank. This packages is mainly a +#' wrapper of the lower-level package `wbpip` +#' +#' @section pipster functions: The pipster functions are divided in X groups. +#' The first, and most important is a set of functions to estimate specific +#' indicators using as input the welfare and weights vector of microdata or +#' group data. +#' +#' @docType package +#' @name pipster +#' @import collapse + +# Make sure data.table knows we know we're using it +# .datatable.aware = TRUE + +# Prevent R CMD check from complaining about the use of pipe expressions +# standard data.table variables +if (getRversion() >= "2.15.1") { + utils::globalVariables( + names = c( + ".", + ".I", + ".N", + ".SD", + ".", + "!!", + ":=" + ), + package = utils::packageName() + ) +} + + + +NULL diff --git a/man/create_pipster_object.Rd b/man/create_pipster_object.Rd new file mode 100644 index 0000000..19b9ab5 --- /dev/null +++ b/man/create_pipster_object.Rd @@ -0,0 +1,35 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/create_pipster_object.R +\name{create_pipster_object} +\alias{create_pipster_object} +\title{Create Pipster Object} +\usage{ +create_pipster_object( + welfare, + weight = rep(1, length(welfare)), + imputation_id = NULL +) +} +\arguments{ +\item{welfare}{numeric: welfare vector} + +\item{weight}{numeric: weight vector} + +\item{imputation_id}{numeric: vector of ids for multiply imputed data. +Default is NULL} +} +\value{ +list: pipster object containing welfare and weights, +params if grouped data, imputation_id if imputed data +} +\description{ +The first step in using the \code{pipster} package is to create a pipster object. +It creates the appropriate classes for welfare and weights, reformats the +data if necessary, and, for grouped data, it estimates and selects the lorenz +curves to be used for the estimation of poverty and distributional measures. +} +\examples{ +p <- create_pipster_object(welfare = pip_gd$L, + weight = pip_gd$P) +p +} diff --git a/man/default_warning_message.Rd b/man/default_warning_message.Rd new file mode 100644 index 0000000..87b3905 --- /dev/null +++ b/man/default_warning_message.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/pipster_md.R +\name{default_warning_message} +\alias{default_warning_message} +\title{Warning message used in default methods for all pipster S3 generic functions} +\usage{ +default_warning_message(generic_name, first_arg) +} +\arguments{ +\item{generic_name}{character: name of generic function of default method} + +\item{first_arg}{object: first argument in the generic function, the class of +which determines the S3 method.} +} +\value{ +warning message +} +\description{ +Warning message used in default methods for all pipster S3 generic functions +} +\keyword{internal} diff --git a/man/get_gini.Rd b/man/get_gini.Rd new file mode 100644 index 0000000..4dc79de --- /dev/null +++ b/man/get_gini.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get_dist.R +\name{get_gini} +\alias{get_gini} +\title{Gini coefficient} +\usage{ +get_gini(pipster_object, ...) +} +\arguments{ +\item{pipster_object}{pipster object created using \link{create_pipster_object}} +} +\value{ +list +} +\description{ +This is a generic function calculating the gini coefficient. +} diff --git a/man/get_gini.default.Rd b/man/get_gini.default.Rd new file mode 100644 index 0000000..888fd05 --- /dev/null +++ b/man/get_gini.default.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get_dist.R +\name{get_gini.default} +\alias{get_gini.default} +\title{Gini coefficient S3 default} +\usage{ +\method{get_gini}{default}(pipster_object, ...) +} +\arguments{ +\item{pipster_object}{pipster object created using \link{create_pipster_object}} + +\item{...}{additional arguments} +} +\value{ +list +} +\description{ +This default S3 method returns an error when called +} diff --git a/man/get_gini.pipster_gd.Rd b/man/get_gini.pipster_gd.Rd new file mode 100644 index 0000000..075b8c5 --- /dev/null +++ b/man/get_gini.pipster_gd.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get_dist.R +\name{get_gini.pipster_gd} +\alias{get_gini.pipster_gd} +\title{Gini coefficient on group data} +\usage{ +\method{get_gini}{pipster_gd}(pipster_object, ...) +} +\arguments{ +\item{pipster_object}{pipster object created using \link{create_pipster_object}} + +\item{...}{additional arguments passed to \link{pipgd_gini}} +} +\value{ +list +} +\description{ +This is a method for computing the gini coefficient on group data. +Requires a pipster object of class \code{pipster_gd} (grouped data object). +This is a wrapper over \link{pipgd_gini}, which should be viewed +for more detail. +} diff --git a/man/get_gini.pipster_md.Rd b/man/get_gini.pipster_md.Rd new file mode 100644 index 0000000..5aca2d3 --- /dev/null +++ b/man/get_gini.pipster_md.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get_dist.R +\name{get_gini.pipster_md} +\alias{get_gini.pipster_md} +\title{Gini coefficient on micro data} +\usage{ +\method{get_gini}{pipster_md}(pipster_object, ...) +} +\arguments{ +\item{pipster_object}{pipster object created using \link{create_pipster_object}} + +\item{...}{additional arguments passed to \link{pipmd_gini}} +} +\value{ +list +} +\description{ +This is a method for computing the gini coefficient on micro data. +Requires a pipster object of class \code{pipster_md} (grouped micro object). +This is a wrapper over \link{pipmd_gini}, which should be viewed +for more detail. +} diff --git a/man/get_mld.Rd b/man/get_mld.Rd new file mode 100644 index 0000000..920ead5 --- /dev/null +++ b/man/get_mld.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get_dist.R +\name{get_mld} +\alias{get_mld} +\title{Mean Log Deviation} +\usage{ +get_mld(pipster_object, ...) +} +\arguments{ +\item{pipster_object}{pipster object created using \link{create_pipster_object}} +} +\value{ +list +} +\description{ +This is a generic function to compute the +Mean Log Deviation (MLD). +} diff --git a/man/get_mld.default.Rd b/man/get_mld.default.Rd new file mode 100644 index 0000000..ebc4dcd --- /dev/null +++ b/man/get_mld.default.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get_dist.R +\name{get_mld.default} +\alias{get_mld.default} +\title{MLD S3 default} +\usage{ +\method{get_mld}{default}(pipster_object, ...) +} +\arguments{ +\item{pipster_object}{pipster object created using \link{create_pipster_object}} + +\item{...}{additional arguments} +} +\value{ +list +} +\description{ +This default S3 method returns an error when called +} diff --git a/man/get_mld.pipster_gd.Rd b/man/get_mld.pipster_gd.Rd new file mode 100644 index 0000000..464f7da --- /dev/null +++ b/man/get_mld.pipster_gd.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get_dist.R +\name{get_mld.pipster_gd} +\alias{get_mld.pipster_gd} +\title{Mean Log Deviation (MLD) for group data} +\usage{ +\method{get_mld}{pipster_gd}(pipster_object, ...) +} +\arguments{ +\item{pipster_object}{pipster object created using \link{create_pipster_object}} + +\item{...}{additional arguments passed to \link{pipgd_mld}} +} +\value{ +list +} +\description{ +This is a method to compute the MLD on group data. +Requires a pipster object of class \code{pipster_gd} (grouped data object). +This is a wrapper over \link{pipgd_mld}, which should be viewed +for more detail. +} diff --git a/man/get_mld.pipster_md.Rd b/man/get_mld.pipster_md.Rd new file mode 100644 index 0000000..69de41c --- /dev/null +++ b/man/get_mld.pipster_md.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get_dist.R +\name{get_mld.pipster_md} +\alias{get_mld.pipster_md} +\title{Mean Log Deviation (MLD) for micro data} +\usage{ +\method{get_mld}{pipster_md}(pipster_object, ...) +} +\arguments{ +\item{pipster_object}{pipster object created using \link{create_pipster_object}} + +\item{...}{additional arguments passed to \link{pipmd_mld}} +} +\value{ +list +} +\description{ +This is a method to compute the MLD on group data. +Requires a pipster object of class \code{pipster_md} (grouped data object). +This is a wrapper over \link{pipmd_mld}, which should be viewed +for more detail. +} diff --git a/man/get_polarization.Rd b/man/get_polarization.Rd new file mode 100644 index 0000000..1857802 --- /dev/null +++ b/man/get_polarization.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get_dist.R +\name{get_polarization} +\alias{get_polarization} +\title{Wolfson polarization index} +\usage{ +get_polarization(pipster_object, ...) +} +\arguments{ +\item{pipster_object}{pipster object created using \link{create_pipster_object}} +} +\value{ +list +} +\description{ +This is a generic function to compute the Wolfson polarization index. +} diff --git a/man/get_polarization.default.Rd b/man/get_polarization.default.Rd new file mode 100644 index 0000000..59095b1 --- /dev/null +++ b/man/get_polarization.default.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get_dist.R +\name{get_polarization.default} +\alias{get_polarization.default} +\title{Wolfson polarization index S3 default} +\usage{ +\method{get_polarization}{default}(pipster_object, ...) +} +\arguments{ +\item{pipster_object}{pipster object created using \link{create_pipster_object}} + +\item{...}{additional arguments} +} +\value{ +list +} +\description{ +This default S3 method returns an error when called +} diff --git a/man/get_polarization.pipster_gd.Rd b/man/get_polarization.pipster_gd.Rd new file mode 100644 index 0000000..fa40b35 --- /dev/null +++ b/man/get_polarization.pipster_gd.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get_dist.R +\name{get_polarization.pipster_gd} +\alias{get_polarization.pipster_gd} +\title{Wolfson polarization index} +\usage{ +\method{get_polarization}{pipster_gd}(pipster_object, ...) +} +\arguments{ +\item{pipster_object}{pipster object created using \link{create_pipster_object}} + +\item{...}{additional arguments passed to pipgd_polarization} +} +\value{ +list +} +\description{ +This is a method to compute the Wolfson polarization index on group data. +Requires a pipster object of class \code{pipster_gd} (grouped data object). +This is a wrapper over pipgd_polarization, which should be viewed +for more detail. +} diff --git a/man/get_polarization.pipster_md.Rd b/man/get_polarization.pipster_md.Rd new file mode 100644 index 0000000..65f219b --- /dev/null +++ b/man/get_polarization.pipster_md.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get_dist.R +\name{get_polarization.pipster_md} +\alias{get_polarization.pipster_md} +\title{Wolfson polarization index} +\usage{ +\method{get_polarization}{pipster_md}(pipster_object, ...) +} +\arguments{ +\item{pipster_object}{pipster object created using \link{create_pipster_object}} + +\item{...}{additional arguments passed to \link{pipmd_polarization}} +} +\value{ +list +} +\description{ +This is a method to compute the Wolfson polarization index on micro data. +Requires a pipster object of class \code{pipster_md} (micro data object). +This is a wrapper over \link{pipmd_polarization}, which should be viewed +for more detail. +} diff --git a/man/get_pov_gap.Rd b/man/get_pov_gap.Rd new file mode 100644 index 0000000..8ca5e55 --- /dev/null +++ b/man/get_pov_gap.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get_pov.R +\name{get_pov_gap} +\alias{get_pov_gap} +\title{Calculate poverty gap} +\usage{ +get_pov_gap(pipster_object, povline, ...) +} +\arguments{ +\item{pipster_object}{pipster object created using \link{create_pipster_object}} + +\item{povline}{numeric: Poverty line in international dollars, same units as welfare.} +} +\value{ +list +} +\description{ +This is a generic function to compute the +poverty gap - i.e. FGT 1. +} diff --git a/man/get_pov_gap.default.Rd b/man/get_pov_gap.default.Rd new file mode 100644 index 0000000..3793c44 --- /dev/null +++ b/man/get_pov_gap.default.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get_pov.R +\name{get_pov_gap.default} +\alias{get_pov_gap.default} +\title{Calculate poverty gap default method} +\usage{ +\method{get_pov_gap}{default}(pipster_object, ...) +} +\arguments{ +\item{pipster_object}{pipster object created using \link{create_pipster_object}} + +\item{...}{additional arguments} +} +\value{ +list +} +\description{ +This default S3 method returns an error when called +} diff --git a/man/get_pov_gap.pipster_gd.Rd b/man/get_pov_gap.pipster_gd.Rd new file mode 100644 index 0000000..d410aa6 --- /dev/null +++ b/man/get_pov_gap.pipster_gd.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get_pov.R +\name{get_pov_gap.pipster_gd} +\alias{get_pov_gap.pipster_gd} +\title{Calculate poverty gap for group data} +\usage{ +\method{get_pov_gap}{pipster_gd}(pipster_object, povline, ...) +} +\arguments{ +\item{pipster_object}{pipster object created using \link{create_pipster_object}} + +\item{povline}{numeric: Poverty line in international dollars, same units as welfare.} + +\item{...}{additional arguments passed to \link{pipgd_pov_gap}} +} +\value{ +list +} +\description{ +This is a method to compute poverty gap on group data. +Requires a pipster object of class \code{pipster_gd} (grouped data object). +This is a wrapper over \link{pipgd_pov_gap}, which should be viewed +for more detail. +} diff --git a/man/get_pov_gap.pipster_md.Rd b/man/get_pov_gap.pipster_md.Rd new file mode 100644 index 0000000..e946608 --- /dev/null +++ b/man/get_pov_gap.pipster_md.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get_pov.R +\name{get_pov_gap.pipster_md} +\alias{get_pov_gap.pipster_md} +\title{Calculate poverty gap for micro data} +\usage{ +\method{get_pov_gap}{pipster_md}(pipster_object, povline, ...) +} +\arguments{ +\item{pipster_object}{pipster object created using \link{create_pipster_object}} + +\item{povline}{numeric: Poverty line in international dollars, same units as welfare.} + +\item{...}{additional arguments passed to \link{pipmd_pov_gap}} +} +\value{ +list +} +\description{ +This is a method to compute poverty gap on micro data. +Requires a pipster object of class \code{pipster_md} (micro data object). +This is a wrapper over \link{pipmd_pov_gap}, which should be viewed +for more detail. +} diff --git a/man/get_pov_headcount.Rd b/man/get_pov_headcount.Rd new file mode 100644 index 0000000..d78e2a6 --- /dev/null +++ b/man/get_pov_headcount.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get_pov.R +\name{get_pov_headcount} +\alias{get_pov_headcount} +\title{Calculate poverty headcount} +\usage{ +get_pov_headcount(pipster_object, povline, ...) +} +\arguments{ +\item{pipster_object}{pipster object created using \link{create_pipster_object}} + +\item{povline}{numeric: Poverty line in international dollars, same units as welfare.} +} +\value{ +list +} +\description{ +This is a generic function to compute the +poverty headcount ratio - i.e. FGT 0. +} diff --git a/man/get_pov_headcount.default.Rd b/man/get_pov_headcount.default.Rd new file mode 100644 index 0000000..02e821c --- /dev/null +++ b/man/get_pov_headcount.default.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get_pov.R +\name{get_pov_headcount.default} +\alias{get_pov_headcount.default} +\title{Calculate poverty headcount default method} +\usage{ +\method{get_pov_headcount}{default}(pipster_object, ...) +} +\arguments{ +\item{pipster_object}{pipster object created using \link{create_pipster_object}} + +\item{...}{additional arguments} +} +\value{ +list +} +\description{ +This default S3 method returns an error when called +} diff --git a/man/get_pov_headcount.pipster_gd.Rd b/man/get_pov_headcount.pipster_gd.Rd new file mode 100644 index 0000000..3da4c8f --- /dev/null +++ b/man/get_pov_headcount.pipster_gd.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get_pov.R +\name{get_pov_headcount.pipster_gd} +\alias{get_pov_headcount.pipster_gd} +\title{Calculate poverty headcount for group data} +\usage{ +\method{get_pov_headcount}{pipster_gd}(pipster_object, povline, ...) +} +\arguments{ +\item{pipster_object}{pipster object created using \link{create_pipster_object}} + +\item{povline}{numeric: Poverty line in international dollars, same units as welfare.} + +\item{...}{additional arguments passed to \link{pipgd_pov_headcount}} +} +\value{ +list +} +\description{ +This is a method to compute poverty headcount on group data. +Requires a pipster object of class \code{pipster_gd} (grouped data object). +This is a wrapper over \link{pipgd_pov_headcount}, which should be viewed +for more detail. +} diff --git a/man/get_pov_headcount.pipster_md.Rd b/man/get_pov_headcount.pipster_md.Rd new file mode 100644 index 0000000..f8c508f --- /dev/null +++ b/man/get_pov_headcount.pipster_md.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get_pov.R +\name{get_pov_headcount.pipster_md} +\alias{get_pov_headcount.pipster_md} +\title{Calculate poverty headcount for micro data} +\usage{ +\method{get_pov_headcount}{pipster_md}(pipster_object, povline, ...) +} +\arguments{ +\item{pipster_object}{pipster object created using \link{create_pipster_object}} + +\item{povline}{numeric: Poverty line in international dollars, same units as welfare.} + +\item{...}{additional arguments passed to \link{pipmd_pov_headcount}} +} +\value{ +list +} +\description{ +This is a method to compute poverty headcount on micro data. +Requires a pipster object of class \code{pipster_md} (grouped data object). +This is a wrapper over \link{pipmd_pov_headcount}, which should be viewed +for more detail. +} diff --git a/man/get_pov_severity.Rd b/man/get_pov_severity.Rd new file mode 100644 index 0000000..7581558 --- /dev/null +++ b/man/get_pov_severity.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get_pov.R +\name{get_pov_severity} +\alias{get_pov_severity} +\title{Calculate poverty severity} +\usage{ +get_pov_severity(pipster_object, povline, ...) +} +\arguments{ +\item{pipster_object}{pipster object created using \link{create_pipster_object}} + +\item{povline}{numeric: Poverty line in international dollars, same units as welfare.} +} +\value{ +list +} +\description{ +This is a generic function to compute the +poverty severity - i.e. FGT 2. +} diff --git a/man/get_pov_severity.default.Rd b/man/get_pov_severity.default.Rd new file mode 100644 index 0000000..0bd22fb --- /dev/null +++ b/man/get_pov_severity.default.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get_pov.R +\name{get_pov_severity.default} +\alias{get_pov_severity.default} +\title{Calculate poverty severity default method} +\usage{ +\method{get_pov_severity}{default}(pipster_object, ...) +} +\arguments{ +\item{pipster_object}{pipster object created using \link{create_pipster_object}} + +\item{...}{additional arguments} +} +\value{ +list +} +\description{ +This default S3 method returns an error when called +} diff --git a/man/get_pov_severity.pipster_gd.Rd b/man/get_pov_severity.pipster_gd.Rd new file mode 100644 index 0000000..1f8cfc9 --- /dev/null +++ b/man/get_pov_severity.pipster_gd.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get_pov.R +\name{get_pov_severity.pipster_gd} +\alias{get_pov_severity.pipster_gd} +\title{Calculate poverty severity for group data} +\usage{ +\method{get_pov_severity}{pipster_gd}(pipster_object, povline, ...) +} +\arguments{ +\item{pipster_object}{pipster object created using \link{create_pipster_object}} + +\item{povline}{numeric: Poverty line in international dollars, same units as welfare.} + +\item{...}{additional arguments passed to \link{pipgd_pov_severity}} +} +\value{ +list +} +\description{ +This is a method to compute poverty severity on group data. +Requires a pipster object of class \code{pipster_gd} (grouped data object). +This is a wrapper over \link{pipgd_pov_severity}, which should be viewed +for more detail. +} diff --git a/man/get_pov_severity.pipster_md.Rd b/man/get_pov_severity.pipster_md.Rd new file mode 100644 index 0000000..3a615a6 --- /dev/null +++ b/man/get_pov_severity.pipster_md.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get_pov.R +\name{get_pov_severity.pipster_md} +\alias{get_pov_severity.pipster_md} +\title{Calculate poverty severity for micro data} +\usage{ +\method{get_pov_severity}{pipster_md}(pipster_object, povline, ...) +} +\arguments{ +\item{pipster_object}{pipster object created using \link{create_pipster_object}} + +\item{povline}{numeric: Poverty line in international dollars, same units as welfare.} + +\item{...}{additional arguments passed to \link{pipmd_pov_severity}} +} +\value{ +list +} +\description{ +This is a method to compute poverty severity on micro data. +Requires a pipster object of class \code{pipster_md} (micro data object). +This is a wrapper over \link{pipmd_pov_severity}, which should be viewed +for more detail. +} diff --git a/man/get_quantile.Rd b/man/get_quantile.Rd new file mode 100644 index 0000000..34c2295 --- /dev/null +++ b/man/get_quantile.Rd @@ -0,0 +1,27 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get_dist.R +\name{get_quantile} +\alias{get_quantile} +\title{Quantile welfare values} +\usage{ +get_quantile( + pipster_object, + n = 10, + popshare = seq(from = 1/n, to = 1, by = 1/n), + ... +) +} +\arguments{ +\item{pipster_object}{pipster object created using \link{create_pipster_object}} + +\item{n}{numeric scalar for the number of quantiles to be used in \code{popshare}} + +\item{popshare}{numeric: vector of share of population. Default is \code{seq(from = 1/n, to = 1, by = 1/n)}} +} +\value{ +list +} +\description{ +Gives the \code{n} quantile welfare values for the given welfare and weight vectors. +This is a generic function. +} diff --git a/man/get_quantile.default.Rd b/man/get_quantile.default.Rd new file mode 100644 index 0000000..47ece21 --- /dev/null +++ b/man/get_quantile.default.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get_dist.R +\name{get_quantile.default} +\alias{get_quantile.default} +\title{Quantile welfare values} +\usage{ +\method{get_quantile}{default}( + pipster_object, + n = 10, + popshare = seq(from = 1/n, to = 1, by = 1/n), + ... +) +} +\arguments{ +\item{pipster_object}{pipster object created using \link{create_pipster_object}} + +\item{n}{numeric scalar for the number of quantiles to be used in \code{popshare}} + +\item{popshare}{numeric: vector of share of population. Default is \code{seq(from = 1/n, to = 1, by = 1/n)}} + +\item{...}{additional arguments} +} +\value{ +list +} +\description{ +This default S3 method returns an error when called +} diff --git a/man/get_quantile.pipster_gd.Rd b/man/get_quantile.pipster_gd.Rd new file mode 100644 index 0000000..959dd81 --- /dev/null +++ b/man/get_quantile.pipster_gd.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get_dist.R +\name{get_quantile.pipster_gd} +\alias{get_quantile.pipster_gd} +\title{Quantile welfare values} +\usage{ +\method{get_quantile}{pipster_gd}( + pipster_object, + n = 10, + popshare = seq(from = 1/n, to = 1, by = 1/n), + ... +) +} +\arguments{ +\item{pipster_object}{pipster object created using \link{create_pipster_object}} + +\item{n}{numeric scalar for the number of quantiles to be used in \code{popshare}} + +\item{popshare}{numeric: vector of share of population. Default is \code{seq(from = 1/n, to = 1, by = 1/n)}} + +\item{...}{additional arguments passed to \link{pipgd_quantile}} +} +\value{ +list +} +\description{ +Gives the \code{n} quantile welfare values for the given welfare and weight vectors. +This is for \code{pipster_gd} grouped data objects. This is a wrapper +over \link{pipgd_quantile}. Requires a pipster object of class \code{pipster_gd} +(grouped data object). +} diff --git a/man/get_quantile.pipster_md.Rd b/man/get_quantile.pipster_md.Rd new file mode 100644 index 0000000..64deac3 --- /dev/null +++ b/man/get_quantile.pipster_md.Rd @@ -0,0 +1,30 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get_dist.R +\name{get_quantile.pipster_md} +\alias{get_quantile.pipster_md} +\title{Quantile welfare values} +\usage{ +\method{get_quantile}{pipster_md}( + pipster_object, + n = 10, + popshare = seq(from = 1/n, to = 1, by = 1/n), + ... +) +} +\arguments{ +\item{pipster_object}{pipster object created using \link{create_pipster_object}} + +\item{n}{numeric scalar for the number of quantiles to be used in \code{popshare}} + +\item{popshare}{numeric: vector of share of population. Default is \code{seq(from = 1/n, to = 1, by = 1/n)}} + +\item{...}{additional arguments passed to \link{pipmd_quantile}} +} +\value{ +list +} +\description{ +Gives the \code{n} quantile welfare values for the given welfare and weight vectors. +This is for \code{pipster_gd} grouped data objects. This is a wrapper +over \link{pipmd_quantile}, which should be viewed for more detail. +} diff --git a/man/get_quantile_welfare_share.Rd b/man/get_quantile_welfare_share.Rd new file mode 100644 index 0000000..8235881 --- /dev/null +++ b/man/get_quantile_welfare_share.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get_dist.R +\name{get_quantile_welfare_share} +\alias{get_quantile_welfare_share} +\title{Quantile welfare share} +\usage{ +get_quantile_welfare_share( + pipster_object, + n = 10, + popshare = seq(from = 1/n, to = 1, by = 1/n), + ... +) +} +\arguments{ +\item{pipster_object}{pipster object created using \link{create_pipster_object}} + +\item{n}{numeric scalar for the number of quantiles to be used in \code{popshare}} + +\item{popshare}{numeric: vector of share of population. Default is \code{seq(from = 1/n, to = 1, by = 1/n)}} +} +\value{ +list +} +\description{ +This is a generic function. +\code{get_quantile_welfare_share} returns the share of welfare held by a +particular quantile. Notice that \link{get_welfare_share_at} gets the share of +welfare held by a particular share of the population, which is essentially +the cumulative share. Instead, \code{get_quantile_welfare_share} returns +the proportion of welfare that only the specified quantile holds. +} diff --git a/man/get_quantile_welfare_share.default.Rd b/man/get_quantile_welfare_share.default.Rd new file mode 100644 index 0000000..c839a5b --- /dev/null +++ b/man/get_quantile_welfare_share.default.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get_dist.R +\name{get_quantile_welfare_share.default} +\alias{get_quantile_welfare_share.default} +\title{Quantile welfare values} +\usage{ +\method{get_quantile_welfare_share}{default}( + pipster_object, + n = 10, + popshare = seq(from = 1/n, to = 1, by = 1/n), + ... +) +} +\arguments{ +\item{pipster_object}{pipster object created using \link{create_pipster_object}} + +\item{n}{numeric scalar for the number of quantiles to be used in \code{popshare}} + +\item{popshare}{numeric: vector of share of population. Default is \code{seq(from = 1/n, to = 1, by = 1/n)}} + +\item{...}{additional arguments} +} +\value{ +list +} +\description{ +This default S3 method returns an error when called +} diff --git a/man/get_quantile_welfare_share.pipster_gd.Rd b/man/get_quantile_welfare_share.pipster_gd.Rd new file mode 100644 index 0000000..27fd155 --- /dev/null +++ b/man/get_quantile_welfare_share.pipster_gd.Rd @@ -0,0 +1,38 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get_dist.R +\name{get_quantile_welfare_share.pipster_gd} +\alias{get_quantile_welfare_share.pipster_gd} +\title{Quantile welfare share in group data} +\usage{ +\method{get_quantile_welfare_share}{pipster_gd}( + pipster_object, + n = 10, + popshare = seq(from = 1/n, to = 1, by = 1/n), + ... +) +} +\arguments{ +\item{pipster_object}{pipster object created using \link{create_pipster_object}} + +\item{n}{numeric scalar for the number of quantiles to be used in \code{popshare}} + +\item{popshare}{numeric: vector of share of population. Default is \code{seq(from = 1/n, to = 1, by = 1/n)}} + +\item{...}{additional arguments passed to \link{pipgd_quantile_welfare_share}} +} +\value{ +list +} +\description{ +This is a generic function. +\code{get_quantile_welfare_share} returns the share of welfare held by a +particular quantile. Notice that \link{get_welfare_share_at} gets the share of +welfare held by a particular share of the population, which is essentially +the cumulative share. Instead, \code{get_quantile_welfare_share} returns +the proportion of welfare that only the specified quantile holds. +} +\details{ +Requires a pipster object of class \code{pipster_gd} (grouped data object). +This is a wrapper over \link{pipgd_quantile_welfare_share}, which should be viewed +for more detail. +} diff --git a/man/get_quantile_welfare_share.pipster_md.Rd b/man/get_quantile_welfare_share.pipster_md.Rd new file mode 100644 index 0000000..59f7a22 --- /dev/null +++ b/man/get_quantile_welfare_share.pipster_md.Rd @@ -0,0 +1,38 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get_dist.R +\name{get_quantile_welfare_share.pipster_md} +\alias{get_quantile_welfare_share.pipster_md} +\title{Quantile welfare share in micro data} +\usage{ +\method{get_quantile_welfare_share}{pipster_md}( + pipster_object, + n = 10, + popshare = seq(from = 1/n, to = 1, by = 1/n), + ... +) +} +\arguments{ +\item{pipster_object}{pipster object created using \link{create_pipster_object}} + +\item{n}{numeric scalar for the number of quantiles to be used in \code{popshare}} + +\item{popshare}{numeric: vector of share of population. Default is \code{seq(from = 1/n, to = 1, by = 1/n)}} + +\item{...}{additional arguments passed to \link{pipmd_quantile_welfare_share}} +} +\value{ +list +} +\description{ +This is a generic function. +\code{get_quantile_welfare_share} returns the share of welfare held by a +particular quantile. Notice that \link{get_welfare_share_at} gets the share of +welfare held by a particular share of the population, which is essentially +the cumulative share. Instead, \code{get_quantile_welfare_share} returns +the proportion of welfare that only the specified quantile holds. +} +\details{ +Requires a pipster object of class \code{pipster_md} (micro data object). +This is a wrapper over \link{pipmd_quantile_welfare_share}, which should be viewed +for more detail. +} diff --git a/man/get_watts.Rd b/man/get_watts.Rd new file mode 100644 index 0000000..2ed3bd0 --- /dev/null +++ b/man/get_watts.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get_pov.R +\name{get_watts} +\alias{get_watts} +\title{Calculate Watts poverty index} +\usage{ +get_watts(pipster_object, povline, ...) +} +\arguments{ +\item{pipster_object}{pipster object created using \link{create_pipster_object}} + +\item{povline}{numeric: Poverty line in international dollars, same units as welfare.} +} +\value{ +list +} +\description{ +This is a generic function to compute the +Watts poverty index +} diff --git a/man/get_watts.default.Rd b/man/get_watts.default.Rd new file mode 100644 index 0000000..c823618 --- /dev/null +++ b/man/get_watts.default.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get_pov.R +\name{get_watts.default} +\alias{get_watts.default} +\title{Calculate Watts poverty index default method} +\usage{ +\method{get_watts}{default}(pipster_object, ...) +} +\arguments{ +\item{pipster_object}{pipster object created using \link{create_pipster_object}} + +\item{...}{additional arguments} +} +\value{ +list +} +\description{ +This default S3 method returns an error when called +} diff --git a/man/get_watts.pipster_gd.Rd b/man/get_watts.pipster_gd.Rd new file mode 100644 index 0000000..e1f4f3e --- /dev/null +++ b/man/get_watts.pipster_gd.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get_pov.R +\name{get_watts.pipster_gd} +\alias{get_watts.pipster_gd} +\title{Calculate Watts poverty index for group data} +\usage{ +\method{get_watts}{pipster_gd}(pipster_object, povline, ...) +} +\arguments{ +\item{pipster_object}{pipster object created using \link{create_pipster_object}} + +\item{povline}{numeric: Poverty line in international dollars, same units as welfare.} + +\item{...}{additional arguments passed to \link{pipgd_watts}} +} +\value{ +list +} +\description{ +This is a method to compute Watts poverty indexon group data. +Requires a pipster object of class \code{pipster_gd} (grouped data object). +This is a wrapper over \link{pipgd_watts}, which should be viewed +for more detail. +} diff --git a/man/get_watts.pipster_md.Rd b/man/get_watts.pipster_md.Rd new file mode 100644 index 0000000..76c9ab0 --- /dev/null +++ b/man/get_watts.pipster_md.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get_pov.R +\name{get_watts.pipster_md} +\alias{get_watts.pipster_md} +\title{Calculate Watts poverty index for micro data} +\usage{ +\method{get_watts}{pipster_md}(pipster_object, povline, ...) +} +\arguments{ +\item{pipster_object}{pipster object created using \link{create_pipster_object}} + +\item{povline}{numeric: Poverty line in international dollars, same units as welfare.} + +\item{...}{additional arguments passed to \link{pipmd_watts}} +} +\value{ +list +} +\description{ +This is a method to compute Watts poverty index on micro data. +Requires a pipster object of class \code{pipster_md} (micro data object). +This is a wrapper over \link{pipmd_watts}, which should be viewed +for more detail. +} diff --git a/man/get_welfare_share_at.Rd b/man/get_welfare_share_at.Rd new file mode 100644 index 0000000..e1150d6 --- /dev/null +++ b/man/get_welfare_share_at.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get_dist.R +\name{get_welfare_share_at} +\alias{get_welfare_share_at} +\title{Welfare share by quantile} +\usage{ +get_welfare_share_at( + pipster_object, + n = 10, + popshare = seq(from = 1/n, to = 1, by = 1/n), + ... +) +} +\arguments{ +\item{pipster_object}{pipster object created using \link{create_pipster_object}} + +\item{n}{numeric scalar for the number of quantiles to be used in \code{popshare}} + +\item{popshare}{numeric: vector of share of population. Default is \code{seq(from = 1/n, to = 1, by = 1/n)}} +} +\value{ +list +} +\description{ +Generic function. Returns the share of welfare held by the specified +share of the population in the parameter \code{popshare}. Alternatively, you can +select the number of quantiles (10 be default), to estimate the corresponding +share of welfare in each. +} diff --git a/man/get_welfare_share_at.default.Rd b/man/get_welfare_share_at.default.Rd new file mode 100644 index 0000000..6408d73 --- /dev/null +++ b/man/get_welfare_share_at.default.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get_dist.R +\name{get_welfare_share_at.default} +\alias{get_welfare_share_at.default} +\title{Quantile welfare values} +\usage{ +\method{get_welfare_share_at}{default}( + pipster_object, + n = 10, + popshare = seq(from = 1/n, to = 1, by = 1/n), + ... +) +} +\arguments{ +\item{pipster_object}{pipster object created using \link{create_pipster_object}} + +\item{n}{numeric scalar for the number of quantiles to be used in \code{popshare}} + +\item{popshare}{numeric: vector of share of population. Default is \code{seq(from = 1/n, to = 1, by = 1/n)}} + +\item{...}{additional arguments} +} +\value{ +list +} +\description{ +This default S3 method returns an error when called. +} diff --git a/man/get_welfare_share_at.pipster_gd.Rd b/man/get_welfare_share_at.pipster_gd.Rd new file mode 100644 index 0000000..faf4dd3 --- /dev/null +++ b/man/get_welfare_share_at.pipster_gd.Rd @@ -0,0 +1,36 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get_dist.R +\name{get_welfare_share_at.pipster_gd} +\alias{get_welfare_share_at.pipster_gd} +\title{Welfare share by quantile in group data} +\usage{ +\method{get_welfare_share_at}{pipster_gd}( + pipster_object, + n = 10, + popshare = seq(from = 1/n, to = 1, by = 1/n), + ... +) +} +\arguments{ +\item{pipster_object}{pipster object created using \link{create_pipster_object}} + +\item{n}{numeric scalar for the number of quantiles to be used in \code{popshare}} + +\item{popshare}{numeric: vector of share of population. Default is \code{seq(from = 1/n, to = 1, by = 1/n)}} + +\item{...}{additional arguments passed to \link{pipgd_welfare_share_at}} +} +\value{ +list +} +\description{ +Returns the share of welfare held by the specified +share of the population in the parameter \code{popshare}. Alternatively, you can +select the number of quantiles (10 be default), to estimate the corresponding +share of welfare in each. +} +\details{ +Requires a pipster object of class \code{pipster_gd} (grouped data object). +This is a wrapper over \link{pipgd_welfare_share_at}, which should be viewed +for more detail. +} diff --git a/man/get_welfare_share_at.pipster_md.Rd b/man/get_welfare_share_at.pipster_md.Rd new file mode 100644 index 0000000..b17fc6d --- /dev/null +++ b/man/get_welfare_share_at.pipster_md.Rd @@ -0,0 +1,33 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get_dist.R +\name{get_welfare_share_at.pipster_md} +\alias{get_welfare_share_at.pipster_md} +\title{Quantile welfare values} +\usage{ +\method{get_welfare_share_at}{pipster_md}( + pipster_object, + n = 10, + popshare = seq(from = 1/n, to = 1, by = 1/n), + ... +) +} +\arguments{ +\item{pipster_object}{pipster object created using \link{create_pipster_object}} + +\item{n}{numeric scalar for the number of quantiles to be used in \code{popshare}} + +\item{popshare}{numeric: vector of share of population. Default is \code{seq(from = 1/n, to = 1, by = 1/n)}} + +\item{...}{additional arguments passed to \link{pipmd_welfare_share_at}} +} +\value{ +list +} +\description{ +Gives the \code{n} quantile welfare values for the given welfare and weight vectors. +} +\details{ +Requires a pipster object of class \code{pipster_md} (grouped data object). +This is a wrapper over \link{pipmd_welfare_share_at}, which should be viewed +for more detail. +} diff --git a/man/pipgd_gini.Rd b/man/pipgd_gini.Rd index bd43cff..90d282e 100644 --- a/man/pipgd_gini.Rd +++ b/man/pipgd_gini.Rd @@ -5,6 +5,7 @@ \title{Compute Gini coefficient} \usage{ pipgd_gini( + pipster_object = NULL, params = NULL, welfare = NULL, weight = NULL, @@ -13,6 +14,8 @@ pipgd_gini( ) } \arguments{ +\item{pipster_object}{pipster object created using \link{create_pipster_object}} + \item{params}{list of parameters from \code{pipgd_validate_lorenz()}} \item{welfare}{numeric vector of cumulative share of welfare (income/consumption)} diff --git a/man/pipgd_mld.Rd b/man/pipgd_mld.Rd index 988546d..7842654 100644 --- a/man/pipgd_mld.Rd +++ b/man/pipgd_mld.Rd @@ -5,6 +5,7 @@ \title{Compute MLD} \usage{ pipgd_mld( + pipster_object = NULL, params = NULL, welfare = NULL, weight = NULL, @@ -13,6 +14,8 @@ pipgd_mld( ) } \arguments{ +\item{pipster_object}{pipster object created using \link{create_pipster_object}} + \item{params}{list of parameters from \code{pipgd_validate_lorenz()}} \item{welfare}{numeric vector of cumulative share of welfare (income/consumption)} diff --git a/man/pipgd_pov_gap.Rd b/man/pipgd_pov_gap.Rd index ea2668c..79f2bbb 100644 --- a/man/pipgd_pov_gap.Rd +++ b/man/pipgd_pov_gap.Rd @@ -5,6 +5,7 @@ \title{Estimate poverty gap (FGT1)} \usage{ pipgd_pov_gap( + pipster_object = NULL, params = NULL, welfare = NULL, weight = NULL, @@ -18,6 +19,8 @@ pipgd_pov_gap( ) } \arguments{ +\item{pipster_object}{pipster object created using \link{create_pipster_object}} + \item{params}{list of parameters from \code{pipgd_validate_lorenz()}} \item{welfare}{numeric vector of cumulative share of welfare (income/consumption)} diff --git a/man/pipgd_pov_gap_nv.Rd b/man/pipgd_pov_gap_nv.Rd index 7779a15..70d122e 100644 --- a/man/pipgd_pov_gap_nv.Rd +++ b/man/pipgd_pov_gap_nv.Rd @@ -5,6 +5,7 @@ \title{Estimate poverty gap (FGT1)} \usage{ pipgd_pov_gap_nv( + pipster_object = NULL, params = NULL, welfare = NULL, weight = NULL, @@ -17,6 +18,8 @@ pipgd_pov_gap_nv( ) } \arguments{ +\item{pipster_object}{pipster object created using \link{create_pipster_object}} + \item{params}{list of parameters from \code{pipgd_validate_lorenz()}} \item{welfare}{numeric vector of cumulative share of welfare (income/consumption)} diff --git a/man/pipgd_pov_headcount.Rd b/man/pipgd_pov_headcount.Rd index fed3691..331d8a2 100644 --- a/man/pipgd_pov_headcount.Rd +++ b/man/pipgd_pov_headcount.Rd @@ -5,6 +5,7 @@ \title{Estimate poverty headcount (FGT0)} \usage{ pipgd_pov_headcount( + pipster_object = NULL, params = NULL, welfare = NULL, weight = NULL, @@ -18,6 +19,8 @@ pipgd_pov_headcount( ) } \arguments{ +\item{pipster_object}{pipster object created using \link{create_pipster_object}} + \item{params}{list of parameters from \code{pipgd_validate_lorenz()}} \item{welfare}{numeric vector of cumulative share of welfare (income/consumption)} diff --git a/man/pipgd_pov_headcount_nv.Rd b/man/pipgd_pov_headcount_nv.Rd index b6e2dab..b6cb621 100644 --- a/man/pipgd_pov_headcount_nv.Rd +++ b/man/pipgd_pov_headcount_nv.Rd @@ -5,6 +5,7 @@ \title{Estimate poverty headcount (FGT0)} \usage{ pipgd_pov_headcount_nv( + pipster_object = NULL, params = NULL, welfare = NULL, weight = NULL, @@ -17,6 +18,8 @@ pipgd_pov_headcount_nv( ) } \arguments{ +\item{pipster_object}{pipster object created using \link{create_pipster_object}} + \item{params}{list of parameters from \code{pipgd_validate_lorenz()}} \item{welfare}{numeric vector of cumulative share of welfare (income/consumption)} diff --git a/man/pipgd_pov_severity.Rd b/man/pipgd_pov_severity.Rd index 397280f..84ef837 100644 --- a/man/pipgd_pov_severity.Rd +++ b/man/pipgd_pov_severity.Rd @@ -5,6 +5,7 @@ \title{Estimate poverty severity} \usage{ pipgd_pov_severity( + pipster_object = NULL, params = NULL, welfare = NULL, weight = NULL, @@ -19,6 +20,8 @@ pipgd_pov_severity( ) } \arguments{ +\item{pipster_object}{pipster object created using \link{create_pipster_object}} + \item{params}{list of parameters from \code{pipgd_validate_lorenz()}} \item{welfare}{numeric vector of cumulative share of welfare (income/consumption)} diff --git a/man/pipgd_pov_severity_nv.Rd b/man/pipgd_pov_severity_nv.Rd index c1ce366..b667653 100644 --- a/man/pipgd_pov_severity_nv.Rd +++ b/man/pipgd_pov_severity_nv.Rd @@ -5,6 +5,7 @@ \title{Estimate poverty severity (non-vectorized)} \usage{ pipgd_pov_severity_nv( + pipster_object = pipster_object, params = NULL, welfare = NULL, weight = NULL, @@ -18,6 +19,8 @@ pipgd_pov_severity_nv( ) } \arguments{ +\item{pipster_object}{pipster object created using \link{create_pipster_object}} + \item{params}{list of parameters from \code{pipgd_validate_lorenz()}} \item{welfare}{numeric vector of cumulative share of welfare (income/consumption)} diff --git a/man/pipgd_quantile.Rd b/man/pipgd_quantile.Rd index b4185c3..69f60de 100644 --- a/man/pipgd_quantile.Rd +++ b/man/pipgd_quantile.Rd @@ -5,6 +5,7 @@ \title{Get quantile at specified shared of population - grouped data} \usage{ pipgd_quantile( + pipster_object = NULL, params = NULL, welfare = NULL, weight = NULL, @@ -16,6 +17,8 @@ pipgd_quantile( ) } \arguments{ +\item{pipster_object}{pipster object created using \link{create_pipster_object}} + \item{params}{list of parameters from \code{pipgd_validate_lorenz()}} \item{welfare}{numeric vector of cumulative share of welfare (income/consumption)} diff --git a/man/pipgd_quantile_welfare_share.Rd b/man/pipgd_quantile_welfare_share.Rd index 36c8783..228279f 100644 --- a/man/pipgd_quantile_welfare_share.Rd +++ b/man/pipgd_quantile_welfare_share.Rd @@ -5,6 +5,7 @@ \title{Quantile welfare share} \usage{ pipgd_quantile_welfare_share( + pipster_object = NULL, params = NULL, welfare = NULL, weight = NULL, @@ -15,6 +16,8 @@ pipgd_quantile_welfare_share( ) } \arguments{ +\item{pipster_object}{pipster object created using \link{create_pipster_object}} + \item{params}{list of parameters from \code{pipgd_validate_lorenz()}} \item{welfare}{numeric vector of cumulative share of welfare (income/consumption)} diff --git a/man/pipgd_watts.Rd b/man/pipgd_watts.Rd index f338e28..d553b01 100644 --- a/man/pipgd_watts.Rd +++ b/man/pipgd_watts.Rd @@ -5,6 +5,7 @@ \title{Estimate Watts poverty index} \usage{ pipgd_watts( + pipster_object = pipster_object, params = NULL, welfare = NULL, weight = NULL, @@ -18,6 +19,8 @@ pipgd_watts( ) } \arguments{ +\item{pipster_object}{pipster object created using \link{create_pipster_object}} + \item{params}{list of parameters from \code{pipgd_validate_lorenz()}} \item{welfare}{numeric vector of cumulative share of welfare (income/consumption)} diff --git a/man/pipgd_watts_nv.Rd b/man/pipgd_watts_nv.Rd index 88dca8d..87028ae 100644 --- a/man/pipgd_watts_nv.Rd +++ b/man/pipgd_watts_nv.Rd @@ -5,6 +5,7 @@ \title{Estimate Watts poverty index (non-vectorized)} \usage{ pipgd_watts_nv( + pipster_object = pipster_object, params = NULL, welfare = NULL, weight = NULL, @@ -17,6 +18,8 @@ pipgd_watts_nv( ) } \arguments{ +\item{pipster_object}{pipster object created using \link{create_pipster_object}} + \item{params}{list of parameters from \code{pipgd_validate_lorenz()}} \item{welfare}{numeric vector of cumulative share of welfare (income/consumption)} diff --git a/man/pipgd_welfare_share_at.Rd b/man/pipgd_welfare_share_at.Rd index e4b380e..97db62f 100644 --- a/man/pipgd_welfare_share_at.Rd +++ b/man/pipgd_welfare_share_at.Rd @@ -5,6 +5,7 @@ \title{Welfare share by quantile in group data} \usage{ pipgd_welfare_share_at( + pipster_object = NULL, params = NULL, welfare = NULL, weight = NULL, @@ -15,6 +16,8 @@ pipgd_welfare_share_at( ) } \arguments{ +\item{pipster_object}{pipster object created using \link{create_pipster_object}} + \item{params}{list of parameters from \code{pipgd_validate_lorenz()}} \item{welfare}{numeric vector of cumulative share of welfare (income/consumption)} diff --git a/man/pipmd_gini.Rd b/man/pipmd_gini.Rd index a0429d9..6e14056 100644 --- a/man/pipmd_gini.Rd +++ b/man/pipmd_gini.Rd @@ -5,12 +5,15 @@ \title{Gini coefficient} \usage{ pipmd_gini( + pipster_object = NULL, welfare, weight = rep(1, length = length(welfare)), format = c("dt", "list", "atomic") ) } \arguments{ +\item{pipster_object}{pipster object created using \link{create_pipster_object}} + \item{welfare}{welfare vector} \item{weight}{population weight vector} diff --git a/man/pipmd_mld.Rd b/man/pipmd_mld.Rd index 5686486..ccb2043 100644 --- a/man/pipmd_mld.Rd +++ b/man/pipmd_mld.Rd @@ -5,6 +5,7 @@ \title{Mean Log Deviation} \usage{ pipmd_mld( + pipster_object = NULL, welfare, weight = rep(1, length = length(welfare)), mean = NULL, @@ -12,6 +13,8 @@ pipmd_mld( ) } \arguments{ +\item{pipster_object}{pipster object created using \link{create_pipster_object}} + \item{welfare}{welfare vector} \item{weight}{population weight vector} diff --git a/man/pipmd_polarization.Rd b/man/pipmd_polarization.Rd index ec3163c..73985b6 100644 --- a/man/pipmd_polarization.Rd +++ b/man/pipmd_polarization.Rd @@ -5,6 +5,7 @@ \title{Wolfson polarization index} \usage{ pipmd_polarization( + pipster_object = NULL, welfare, weight = rep(1, length = length(welfare)), gini = NULL, @@ -14,6 +15,8 @@ pipmd_polarization( ) } \arguments{ +\item{pipster_object}{pipster object created using \link{create_pipster_object}} + \item{welfare}{welfare vector} \item{weight}{population weight vector} diff --git a/man/pipmd_pov_gap.Rd b/man/pipmd_pov_gap.Rd index 822a6f8..d360d4b 100644 --- a/man/pipmd_pov_gap.Rd +++ b/man/pipmd_pov_gap.Rd @@ -5,7 +5,8 @@ \title{Calculate poverty gap from microdata} \usage{ pipmd_pov_gap( - welfare, + pipster_object = NULL, + welfare = NULL, weight = rep(1, length = length(welfare)), povline = fmean(welfare, w = weight) * times_mean, times_mean = 1, diff --git a/man/pipmd_pov_gap_nv.Rd b/man/pipmd_pov_gap_nv.Rd index 53df773..e1591c4 100644 --- a/man/pipmd_pov_gap_nv.Rd +++ b/man/pipmd_pov_gap_nv.Rd @@ -5,7 +5,8 @@ \title{Calculate poverty gap using microdata} \usage{ pipmd_pov_gap_nv( - welfare, + pipster_object = NULL, + welfare = NULL, weight = rep(1, length = length(welfare)), povline = fmean(welfare, w = weight) * times_mean, times_mean = 1 diff --git a/man/pipmd_pov_headcount.Rd b/man/pipmd_pov_headcount.Rd index 8d9a627..f054aaf 100644 --- a/man/pipmd_pov_headcount.Rd +++ b/man/pipmd_pov_headcount.Rd @@ -5,7 +5,8 @@ \title{Calculate poverty headcount from microdata} \usage{ pipmd_pov_headcount( - welfare, + pipster_object = NULL, + welfare = NULL, weight = rep(1, length = length(welfare)), povline = fmean(welfare, w = weight) * times_mean, times_mean = 1, diff --git a/man/pipmd_pov_headcount_nv.Rd b/man/pipmd_pov_headcount_nv.Rd index de55df1..df00842 100644 --- a/man/pipmd_pov_headcount_nv.Rd +++ b/man/pipmd_pov_headcount_nv.Rd @@ -5,7 +5,8 @@ \title{Calculate poverty headcount using microdata} \usage{ pipmd_pov_headcount_nv( - welfare, + pipster_object = NULL, + welfare = NULL, weight = rep(1, length = length(welfare)), povline = fmean(welfare, w = weight) * times_mean, times_mean = 1 diff --git a/man/pipmd_pov_severity.Rd b/man/pipmd_pov_severity.Rd index bcb74c4..adc4b28 100644 --- a/man/pipmd_pov_severity.Rd +++ b/man/pipmd_pov_severity.Rd @@ -5,7 +5,8 @@ \title{Calculate poverty severity from microdata} \usage{ pipmd_pov_severity( - welfare, + pipster_object = NULL, + welfare = NULL, weight = rep(1, length = length(welfare)), povline = fmean(welfare, w = weight) * times_mean, times_mean = 1, diff --git a/man/pipmd_pov_severity_nv.Rd b/man/pipmd_pov_severity_nv.Rd index 0306b6b..a2d3bd5 100644 --- a/man/pipmd_pov_severity_nv.Rd +++ b/man/pipmd_pov_severity_nv.Rd @@ -5,7 +5,8 @@ \title{Calculate poverty severity using microdata} \usage{ pipmd_pov_severity_nv( - welfare, + pipster_object = NULL, + welfare = NULL, weight = rep(1, length = length(welfare)), povline = fmean(welfare, w = weight) * times_mean, times_mean = 1 diff --git a/man/pipmd_quantile.Rd b/man/pipmd_quantile.Rd index 09135df..189c733 100644 --- a/man/pipmd_quantile.Rd +++ b/man/pipmd_quantile.Rd @@ -5,7 +5,8 @@ \title{Get quantile at specified shared of population - micro data} \usage{ pipmd_quantile( - welfare, + pipster_object = NULL, + welfare = NULL, weight = rep(1, length = length(welfare)), n = 10, popshare = seq(from = 1/n, to = 1, by = 1/n), @@ -13,6 +14,8 @@ pipmd_quantile( ) } \arguments{ +\item{pipster_object}{pipster object created using \link{create_pipster_object}} + \item{welfare}{welfare vector} \item{weight}{population weight vector} diff --git a/man/pipmd_quantile_welfare_share.Rd b/man/pipmd_quantile_welfare_share.Rd index 884092a..0010ff8 100644 --- a/man/pipmd_quantile_welfare_share.Rd +++ b/man/pipmd_quantile_welfare_share.Rd @@ -5,6 +5,7 @@ \title{Quantile welfare share} \usage{ pipmd_quantile_welfare_share( + pipster_object = NULL, welfare, weight = rep(1, length = length(welfare)), n = 10, @@ -13,6 +14,8 @@ pipmd_quantile_welfare_share( ) } \arguments{ +\item{pipster_object}{pipster object created using \link{create_pipster_object}} + \item{welfare}{welfare vector} \item{weight}{population weight vector} diff --git a/man/pipmd_watts.Rd b/man/pipmd_watts.Rd index 6366cc8..091e14d 100644 --- a/man/pipmd_watts.Rd +++ b/man/pipmd_watts.Rd @@ -5,7 +5,8 @@ \title{Calculate Watts index from microdata} \usage{ pipmd_watts( - welfare, + pipster_object = NULL, + welfare = NULL, weight = rep(1, length = length(welfare)), povline = fmean(welfare, w = weight) * times_mean, times_mean = 1, diff --git a/man/pipmd_watts_nv.Rd b/man/pipmd_watts_nv.Rd index 033b513..ca4b1ca 100644 --- a/man/pipmd_watts_nv.Rd +++ b/man/pipmd_watts_nv.Rd @@ -5,7 +5,8 @@ \title{Calculate Watts index using microdata} \usage{ pipmd_watts_nv( - welfare, + pipster_object = NULL, + welfare = NULL, weight = rep(1, length = length(welfare)), povline = fmean(welfare, w = weight) * times_mean, times_mean = 1 diff --git a/man/pipmd_welfare_share_at.Rd b/man/pipmd_welfare_share_at.Rd index aedc55c..ec1e46b 100644 --- a/man/pipmd_welfare_share_at.Rd +++ b/man/pipmd_welfare_share_at.Rd @@ -5,7 +5,8 @@ \title{Welfare share by quantile in micro data} \usage{ pipmd_welfare_share_at( - welfare, + pipster_object = NULL, + welfare = NULL, weight = rep(1, length = length(welfare)), n = 10, popshare = seq(from = 1/n, to = 1, by = 1/n), @@ -13,6 +14,8 @@ pipmd_welfare_share_at( ) } \arguments{ +\item{pipster_object}{pipster object created using \link{create_pipster_object}} + \item{welfare}{welfare vector} \item{weight}{population weight vector} diff --git a/man/pipster.Rd b/man/pipster.Rd index 2777c68..d27f686 100644 --- a/man/pipster.Rd +++ b/man/pipster.Rd @@ -1,8 +1,7 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/pipster-package.R +% Please edit documentation in R/pipster-package.R, R/pipster.R \docType{package} \name{pipster} -\alias{-package} \alias{pipster} \alias{.datatable.aware} \title{pipster: Poverty and Inequality methodology of WB methodology} @@ -13,6 +12,10 @@ An object of class \code{logical} of length 1. .datatable.aware } \description{ +A higher-level package to estimate socioeconomic indicators on poverty and +inequality using the methodology by the World Bank. This packages is mainly a +wrapper of the lower-level package \code{wbpip} + A higher-level package to estimate socioeconomic indicators on poverty and inequality using the methodology by the World Bank. This packages is mainly a wrapper of the lower-level package \code{wbpip} @@ -21,6 +24,11 @@ wrapper of the lower-level package \code{wbpip} The pipster functions are divided in X groups. The first, and most important is a set of functions to estimate specific indicators using as input the welfare and weights vector of microdata or +group data. + + The pipster functions are divided in X groups. +The first, and most important is a set of functions to estimate specific +indicators using as input the welfare and weights vector of microdata or group data. } diff --git a/man/pipster_gd.Rd b/man/pipster_gd.Rd new file mode 100644 index 0000000..56f1f07 --- /dev/null +++ b/man/pipster_gd.Rd @@ -0,0 +1,30 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/pipster_gd.R +\name{pipster_gd} +\alias{pipster_gd} +\alias{is_pipster_gd} +\alias{as_percent} +\title{\code{pipster_gd} vector} +\usage{ +pipster_gd(x = double()) + +is_pipster_gd(x) + +as_percent(x) +} +\arguments{ +\item{x}{\itemize{ +\item For \code{pipster_gd}: numeric vector +\item For \code{is_pipster_gd}: object to test +\item For \code{as_pipster_gd}: object that should inherit \code{pipster_gd} class +}} +} +\value{ +an S3 vector of class \code{pipster_gd} +} +\description{ +This creates a double vector of group pipster data. +} +\examples{ +pipster_gd(c(0.1, 0.5, 0.9, 1)) +} diff --git a/man/pipster_md.Rd b/man/pipster_md.Rd new file mode 100644 index 0000000..33bb6d5 --- /dev/null +++ b/man/pipster_md.Rd @@ -0,0 +1,30 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/pipster_md.R +\name{pipster_md} +\alias{pipster_md} +\alias{is_pipster_md} +\alias{as_percent} +\title{\code{pipster_md} vector} +\usage{ +pipster_md(x = double()) + +is_pipster_md(x) + +as_percent(x) +} +\arguments{ +\item{x}{\itemize{ +\item For \code{pipster_md}: numeric vector +\item For \code{is_pipster_md}: object to test +\item For \code{as_pipster_md}: object that should inherit \code{pipster_md} class +}} +} +\value{ +an S3 vector of class \code{pipster_md} +} +\description{ +This creates a double vector of group pipster data. +} +\examples{ +pipster_md(c(0.1, 0.5, 0.9, 1)) +} diff --git a/man/validate_params.Rd b/man/validate_params.Rd new file mode 100644 index 0000000..ab1e579 --- /dev/null +++ b/man/validate_params.Rd @@ -0,0 +1,35 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/pipgd_dist.R +\name{validate_params} +\alias{validate_params} +\title{Validate group data parameters} +\usage{ +validate_params( + pipster_object, + welfare, + weight, + params, + mean = 1, + times_mean = 1, + popshare = NULL, + povline = ifelse(is.null(popshare), mean * times_mean, NA_real_) +) +} +\arguments{ +\item{pipster_object}{pipster object created using \link{create_pipster_object}} + +\item{welfare}{numeric vector of cumulative share of welfare (income/consumption)} + +\item{weight}{numeric vector of cumulative share of the population} + +\item{params}{list of parameters from \code{pipgd_validate_lorenz()}} + +\item{popshare}{numeric: vector of share of population. Default is \code{seq(from = 1/n, to = 1, by = 1/n)}} +} +\value{ +list: \code{params} to be used in gd functions +} +\description{ +Validate group data parameters +} +\keyword{internal} From 5a047ae1a0070ff0acfd494755f63dc98c208481 Mon Sep 17 00:00:00 2001 From: zander-prinsloo Date: Tue, 13 Feb 2024 20:52:34 -0500 Subject: [PATCH 17/29] adj polarization, export wbpip function --- R/pipgd_dist.R | 23 +++++++---------------- 1 file changed, 7 insertions(+), 16 deletions(-) diff --git a/R/pipgd_dist.R b/R/pipgd_dist.R index 1ff7508..68b4c01 100644 --- a/R/pipgd_dist.R +++ b/R/pipgd_dist.R @@ -568,8 +568,6 @@ pipgd_mld <- function( #' weight = pip_gd$P, #' complete = TRUE) #' - - pipgd_polarization <- function( params = NULL, welfare = NULL, @@ -583,7 +581,6 @@ pipgd_polarization <- function( # _________________________________________________________________ # Defenses # _________________________________________________________________ - pl <- as.list(environment()) check_pipgd_params(pl) @@ -602,36 +599,30 @@ pipgd_polarization <- function( # _________________________________________________________________ # Select Lorenz # _________________________________________________________________ - if (is.null(lorenz)) { lorenz <- params$selected_lorenz$for_dist } else { match.arg(lorenz, c("lq", "lb")) } - # _________________________________________________________________ - # Set p0 and compute dcm + # Set arguments # _________________________________________________________________ - # p0 - always 0.5 - p0 = 0.5 - mean = mean - - # gini - + # Gini if (is.null(gini)) { gini <- pipgd_gini(welfare = params$data$welfare, weight = params$data$weight, lorenz = lorenz)$dist_stats$gini - } else { - gini <- gini } - dcm = (1 - gini)*mean + # Set arguments + p0 <- 0.5 # constant + dcm <- (1 - gini)*mean # Compute polarization index - polarization_ <- paste0("wbpip:::gd_compute_polarization_", lorenz) |> + polarization_ <- paste0("wbpip::gd_compute_polarization_", + lorenz) |> parse(text = _) polarization <- eval(polarization_)( From 9a1f640ad3cc56dcb301267ead38b176bd4c715e Mon Sep 17 00:00:00 2001 From: zander-prinsloo Date: Tue, 13 Feb 2024 23:06:33 -0500 Subject: [PATCH 18/29] pipgd_dist tests pass, add validate_params test, reduce its args --- R/pipgd_dist.R | 40 +++++++++----------- tests/testthat/test-pipgd_dist.R | 63 ++++++++++++++++++++++++++++---- 2 files changed, 73 insertions(+), 30 deletions(-) diff --git a/R/pipgd_dist.R b/R/pipgd_dist.R index f8aaa85..0de2016 100644 --- a/R/pipgd_dist.R +++ b/R/pipgd_dist.R @@ -79,8 +79,7 @@ pipgd_welfare_share_at <- function( params <- validate_params(pipster_object = pipster_object, welfare = welfare, weight = weight, - params = params, - popshare = popshare) + params = params) if (is.null(lorenz)) { lorenz <- params$selected_lorenz$for_dist @@ -184,8 +183,7 @@ pipgd_quantile_welfare_share <- params <- validate_params(pipster_object = pipster_object, welfare = welfare, weight = weight, - params = params, - popshare = popshare) + params = params) if (is.null(lorenz)) { lorenz <- params$selected_lorenz$for_dist @@ -296,9 +294,7 @@ pipgd_quantile <- params <- validate_params(pipster_object = pipster_object, welfare = welfare, weight = weight, - params = params, - popshare = popshare, - mean = mean) + params = params) if (is.null(lorenz)) { lorenz <- params$selected_lorenz$for_dist @@ -525,11 +521,11 @@ validate_params <- function( pipster_object, welfare, weight, - params, - mean = 1, - times_mean = 1, - popshare = NULL, - povline = ifelse(is.null(popshare), mean * times_mean, NA_real_) + params + #mean = 1, + #times_mean = 1, + #popshare = NULL, + #povline = ifelse(is.null(popshare), mean * times_mean, NA_real_) ){ if (!is.null(pipster_object)) { @@ -539,19 +535,19 @@ validate_params <- function( } else if (!is.null(welfare)) { params <- pipgd_select_lorenz(welfare = welfare, weight = weight, - complete = TRUE, - mean = mean, - times_mean = times_mean, - popshare = popshare, - povline = povline) + complete = TRUE) + # mean = mean, + # times_mean = times_mean, + # popshare = popshare, + # povline = povline) } else { params <- pipgd_select_lorenz(welfare = params$data$welfare, weight = params$data$weight, - complete = TRUE, - mean = mean, - times_mean = times_mean, - popshare = popshare, - povline = povline) + complete = TRUE) + # mean = mean, + # times_mean = times_mean, + # popshare = popshare, + # povline = povline) } params diff --git a/tests/testthat/test-pipgd_dist.R b/tests/testthat/test-pipgd_dist.R index 88b3e68..0e7c938 100644 --- a/tests/testthat/test-pipgd_dist.R +++ b/tests/testthat/test-pipgd_dist.R @@ -1,12 +1,54 @@ # Test functions related to distributional measures for group data #### -# Test pipgd_welfare_share_at function #### - -welfare <- pip_gd$L -weight <- pip_gd$P +welfare <- pip_gd$L |> as.numeric() +weight <- pip_gd$P |> as.numeric() params <- pipgd_select_lorenz(welfare = welfare, weight = weight, complete = TRUE) +pipster_object <- create_pipster_object(welfare = pip_gd$L, + weight = pip_gd$P) + + +# Test validate_params +test_that("validate_params is equiv for all input types", { + + ob1 <- validate_params(pipster_object = pipster_object, + welfare = NULL, + weight = NULL, + params = NULL) + ob2 <- validate_params(pipster_object = NULL, + welfare = welfare, + weight = weight, + params = NULL) + ob3 <- validate_params(pipster_object = NULL, + welfare = NULL, + weight = NULL, + params = params) + + expect_equal(ob1, ob2) + expect_equal(ob1, ob3) + + # does `mean` arg work? + # ob2 <- validate_params_dist(pipster_object = NULL, + # welfare = welfare, + # weight = weight, + # mean = 1, + # params = NULL) + # ob3 <- validate_params(pipster_object = NULL, + # welfare = welfare, + # weight = weight, + # mean = 2, + # params = NULL) + # expect_failure( + # expect_equal(ob2, ob3) + # ) + +}) + + +# Test pipgd_welfare_share_at function #### + + # Inputs ------------------------------------------------------------------------------ @@ -22,6 +64,7 @@ test_that("pipgd_welfare_share_at inputs work as expected", { weight = weight, complete = TRUE, lorenz = "lq") + res3 <- pipgd_welfare_share_at(pipster_object = pipster_object) expect_equal(res1, res2) expect_equal(res1_full$dist_stats, @@ -227,7 +270,8 @@ test_that("pipgd_welfare_share_at outputs work as expected", { names(res_complete$data) |> expect_equal(c("welfare", - "weight")) + "weight", + "mean")) names(res_complete$selected_lorenz) |> expect_equal(c( "for_dist", @@ -398,7 +442,8 @@ test_that("pipgd_quantile_welfare_share outputs work as expected", { names(res_complete$data) |> expect_equal(c("welfare", - "weight")) + "weight", + "mean")) names(res_complete$selected_lorenz) |> expect_equal(c( "for_dist", @@ -592,7 +637,8 @@ test_that("pipgd_quantile outputs work as expected", { names(res_complete$data) |> expect_equal(c("welfare", - "weight")) + "weight", + "mean")) names(res_complete$selected_lorenz) |> expect_equal(c( "for_dist", @@ -837,7 +883,8 @@ test_that("pipgd_mld outputs work as expected", { names(res_complete$data) |> expect_equal(c("welfare", - "weight")) + "weight", + "mean")) names(res_complete$selected_lorenz) |> expect_equal(c( "for_dist", From ef304486881a12c15c7adcba8fb0e1ec0324582e Mon Sep 17 00:00:00 2001 From: zander-prinsloo Date: Wed, 14 Feb 2024 10:41:25 -0500 Subject: [PATCH 19/29] make test pipgd_pov pass, correction --- R/check_params.R | 5 ++--- R/pipgd_pov.R | 17 +++++++-------- tests/testthat/test-pipgd_pov.R | 38 +++++++++++++++++---------------- 3 files changed, 30 insertions(+), 30 deletions(-) diff --git a/R/check_params.R b/R/check_params.R index 8c9cfc0..7a12547 100644 --- a/R/check_params.R +++ b/R/check_params.R @@ -22,13 +22,12 @@ check_pipgd_params <- function(lp) { ## welfare ----------- - ## welfare and params ----------- if ( all(c("params", "welfare") %in% nlp)) { if (!is.null(lp$params) && - (!is.null(lp$welfare) || !is.null(lp$population))) { + (!is.null(lp$welfare) || !is.null(lp$weight))) { cli::cli_abort("You must specify either {.field params} or - {.field welfare} and {.field population}") + {.field welfare} and {.field weight}") } } diff --git a/R/pipgd_pov.R b/R/pipgd_pov.R index 9632620..b5fc713 100644 --- a/R/pipgd_pov.R +++ b/R/pipgd_pov.R @@ -41,8 +41,7 @@ pipgd_pov_headcount_nv <- weight <- params$data$weight } - params <- pipgd_select_lorenz(params = params, - welfare = welfare, + params <- pipgd_select_lorenz(welfare = welfare, weight = weight, mean = mean, times_mean = times_mean, @@ -369,7 +368,7 @@ pipgd_pov_gap <- function(pipster_object = NULL, #' also returns all params. #' @keywords internal pipgd_pov_severity_nv <- function( - pipster_object = pipster_object, + pipster_object = NULL, params = NULL, welfare = NULL, weight = NULL, @@ -628,7 +627,7 @@ pipgd_pov_severity <- function( #' #' @keywords internal pipgd_watts_nv <- function( - pipster_object = pipster_object, + pipster_object = NULL, params = NULL, welfare = NULL, weight = NULL, @@ -677,8 +676,8 @@ pipgd_watts_nv <- function( params$gd_params[[lorenz]]$reg_results$coef[["A"]], params$gd_params[[lorenz]]$reg_results$coef[["B"]], params$gd_params[[lorenz]]$reg_results$coef[["C"]]) - } + } # __________________________________________________________________________ # Calculate Watts ----------------------------------------------------- @@ -689,9 +688,9 @@ pipgd_watts_nv <- function( wr <- eval(watts_)(mean = mean, povline = povline, headcount = params$pov_stats$headcount, - A = params$gd_params$lb$reg_results$coef[["A"]], - B = params$gd_params$lb$reg_results$coef[["B"]], - C = params$gd_params$lb$reg_results$coef[["C"]]) + A = params$gd_params[[lorenz]]$reg_results$coef[["A"]], + B = params$gd_params[[lorenz]]$reg_results$coef[["B"]], + C = params$gd_params[[lorenz]]$reg_results$coef[["C"]]) attributes(wr) <- NULL @@ -759,7 +758,7 @@ pipgd_watts_nv <- function( #' times_mean = 1.5) #' pipgd_watts <- function( - pipster_object = pipster_object, + pipster_object = NULL, params = NULL, welfare = NULL, weight = NULL, diff --git a/tests/testthat/test-pipgd_pov.R b/tests/testthat/test-pipgd_pov.R index 7277031..0885a32 100644 --- a/tests/testthat/test-pipgd_pov.R +++ b/tests/testthat/test-pipgd_pov.R @@ -1,8 +1,8 @@ #_______________________________________________________________________________ # Define Objects---------------------------------------------------------------- #_______________________________________________________________________________ -welfare <- pip_gd$L -weight <- pip_gd$P +welfare <- pip_gd$L |> as.numeric() +weight <- pip_gd$P |> as.numeric() params <- pipgd_select_lorenz(welfare = welfare, weight = weight, complete = TRUE) @@ -227,8 +227,8 @@ test_that("pipgd_pov_gap_nv works as expected", { pov_gap_lq_bm <- 0.18981108366762 - out_lq$pov_stats$pov_gap |> - expect_equal(pov_gap_lq_bm) + round(out_lq$pov_stats$pov_gap, 5) |> + expect_equal(round(pov_gap_lq_bm, 5)) pov_gap_lb_bm <- 0.196668019926771 @@ -333,7 +333,8 @@ test_that("pipgd_pov_gap_nv works as expected", { names(res_params_complete$data) |> expect_equal(c("welfare", - "weight")) + "weight", + "mean")) names(res_params_complete$selected_lorenz) |> expect_equal(c("for_dist", @@ -550,7 +551,7 @@ test_that("pipgd_pov_severity_nv() -pov_gap works", { }) -test_that("pipgd_pov_severity_nv() -complete works", { +test_that("pipgd_pov_severity_nv() -complete & popsahre works", { res_complete <- pipgd_pov_severity_nv(welfare = welfare, weight = weight, complete = TRUE) @@ -559,7 +560,6 @@ test_that("pipgd_pov_severity_nv() -complete works", { # Checking popshare and povline arguments -test_that("pipgd_pov_severity_nv() -popshare works", { popshare = 0.4 pipgd_pov_severity_nv(welfare = welfare, @@ -567,8 +567,6 @@ test_that("pipgd_pov_severity_nv() -popshare works", { popshare = popshare) |> expect_no_error() - }) - # Output-------------------------------------- expect_equal( @@ -625,7 +623,8 @@ test_that("pipgd_pov_severity_nv() -popshare works", { names(res_complete$data) |> expect_equal(c("welfare", - "weight")) + "weight", + "mean")) names(res_complete$selected_lorenz) |> expect_equal(c("for_dist", @@ -982,7 +981,8 @@ test_that("pipgd_watts_nv outputs work as expected", { names(res_complete$data) |> expect_equal(c("welfare", - "weight")) + "weight", + "mean")) names(res_complete$selected_lorenz) |> expect_equal(c( "for_dist", @@ -1005,21 +1005,23 @@ test_that("pipgd_watts_nv watts output is as expected", { complete = TRUE) res_with_lb <- pipgd_watts_nv(welfare = welfare, weight = weight, - lorenz = "lb") + lorenz = "lb", + complete = F) res_with_lq <- pipgd_watts_nv(welfare = welfare, weight = weight, - lorenz = "lq") + lorenz = "lq", + complete = F) res_lb_benchmark <- list(pov_stats = list(watts = 0.277580116426276, lorenz = "lb")) - res_lq_benchmark <- list(pov_stats = list(watts = 0.60555598, + res_lq_benchmark <- list(pov_stats = list(watts = 0.28045418, lorenz = "lq")) - res_with_lb |> - expect_equal(res_lb_benchmark) + round(res_with_lb$pov_stats$watts, 5) |> + expect_equal(round(res_lb_benchmark$pov_stats$watts, 5)) - res_with_lq |> - expect_equal(res_lq_benchmark) + round(res_with_lq$pov_stats$watts, 5) |> + expect_equal(round(res_lq_benchmark$pov_stats$watts, 5)) }) From 8961d8a97a1a7f97492c982292d4ddaa9ad3edee Mon Sep 17 00:00:00 2001 From: zander-prinsloo Date: Wed, 14 Feb 2024 12:13:44 -0500 Subject: [PATCH 20/29] sort gini --- R/pipmd_dist.R | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/R/pipmd_dist.R b/R/pipmd_dist.R index 0581f98..9088a4e 100644 --- a/R/pipmd_dist.R +++ b/R/pipmd_dist.R @@ -303,6 +303,11 @@ pipmd_gini <- function( weight <- pipster_object$weight |> unclass() } + if (is.unsorted(welfare)) { + weight <- weight[order(welfare)] + welfare <- welfare[order(welfare)] + } + # defenses --------- check_pipmd_dist() From 7897d83a0e832920d26b6e931e7014c67af68c08 Mon Sep 17 00:00:00 2001 From: zander-prinsloo Date: Wed, 14 Feb 2024 21:35:41 -0500 Subject: [PATCH 21/29] give imputed type "md" --- R/create_pipster_object.R | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/R/create_pipster_object.R b/R/create_pipster_object.R index 186a118..ddd8760 100644 --- a/R/create_pipster_object.R +++ b/R/create_pipster_object.R @@ -33,7 +33,7 @@ create_pipster_object <- } if (length(weight) > 1 & any(is.na(weight))) { cli::cli_abort("No elements in weight vector can be NA - - leave empty to give equal weighting") + leave argument empty to give equal weighting") } #_____________________________________________________________________________ @@ -55,7 +55,9 @@ create_pipster_object <- "md" = { imputation_id <- rep(1, length(welfare)) }, - "id" = invisible(TRUE), + "id" = { + cl <- "md" + }, "gd_1" = invisible(TRUE), "gd_2" = { welfare <- fcumsum(welfare)/fsum(welfare) From e1d4485c19e9a74726e785307d07706ebb68a366 Mon Sep 17 00:00:00 2001 From: zander-prinsloo Date: Wed, 14 Feb 2024 21:37:01 -0500 Subject: [PATCH 22/29] small modifications --- R/pipgd_dist.R | 4 ++-- R/pipmd_dist.R | 3 +++ R/pipster_gd.R | 2 +- R/pipster_md.R | 6 +++--- 4 files changed, 9 insertions(+), 6 deletions(-) diff --git a/R/pipgd_dist.R b/R/pipgd_dist.R index 0de2016..78bf131 100644 --- a/R/pipgd_dist.R +++ b/R/pipgd_dist.R @@ -177,7 +177,6 @@ pipgd_quantile_welfare_share <- pl <- as.list(environment()) check_pipgd_params(pl) - # ____________________________________________________ # Computations #### params <- validate_params(pipster_object = pipster_object, @@ -194,7 +193,8 @@ pipgd_quantile_welfare_share <- # get shares ------------------------ shr <- pipgd_welfare_share_at(params = params, complete = FALSE, - n = n) + n = n, + popshare = popshare) shr <- c(shr$dist_stats$welfare_share_at[1], diff(shr$dist_stats$welfare_share_at)) diff --git a/R/pipmd_dist.R b/R/pipmd_dist.R index 9088a4e..25d3a2b 100644 --- a/R/pipmd_dist.R +++ b/R/pipmd_dist.R @@ -244,6 +244,9 @@ pipmd_quantile_welfare_share <- function( popshare = popshare, format = format ) + if (is.null(n)) { + output <- output[1] + } # ____________________________________________________________________________ # Return --------------------------------------------------------------------- diff --git a/R/pipster_gd.R b/R/pipster_gd.R index ce7d64b..b1eb840 100644 --- a/R/pipster_gd.R +++ b/R/pipster_gd.R @@ -32,7 +32,7 @@ is_pipster_gd <- function(x) { #' @export #' @rdname pipster_gd -as_percent <- function(x) { +as_pipster_gd <- function(x) { vec_cast(x, new_pipster_gd()) } diff --git a/R/pipster_md.R b/R/pipster_md.R index 5d1ec29..0b1467d 100644 --- a/R/pipster_md.R +++ b/R/pipster_md.R @@ -7,7 +7,7 @@ new_pipster_md <- function(x = double(), ...) { #' `pipster_md` vector #' -#' This creates a double vector of group pipster data. +#' This creates a double vector of pipster micro data. #' #' @param x #' * For `pipster_md`: numeric vector @@ -32,7 +32,7 @@ is_pipster_md <- function(x) { #' @export #' @rdname pipster_md -as_percent <- function(x) { +as_pipster_md <- function(x) { vec_cast(x, new_pipster_md()) } @@ -93,7 +93,7 @@ vec_cast.pipster_md.double <- function(x, to, ...) { #' @export vec_cast.double.pipster_md <- function(x, to, ...) { - vec_data(x) + as.numeric(vec_data(x)) } From 89577bf992eff365ce624169aa25c6a32133a8c4 Mon Sep 17 00:00:00 2001 From: zander-prinsloo Date: Wed, 14 Feb 2024 21:37:43 -0500 Subject: [PATCH 23/29] s3 tests --- tests/testthat/test-create_pipster_object.R | 65 +++++ tests/testthat/test-get_dist.R | 263 ++++++++++++++++++++ tests/testthat/test-pipgd_params.R | 2 +- tests/testthat/test-pipster_gd.R | 96 +++++++ tests/testthat/test-pipster_md.R | 97 ++++++++ 5 files changed, 522 insertions(+), 1 deletion(-) create mode 100644 tests/testthat/test-create_pipster_object.R create mode 100644 tests/testthat/test-get_dist.R create mode 100644 tests/testthat/test-pipster_gd.R create mode 100644 tests/testthat/test-pipster_md.R diff --git a/tests/testthat/test-create_pipster_object.R b/tests/testthat/test-create_pipster_object.R new file mode 100644 index 0000000..695134f --- /dev/null +++ b/tests/testthat/test-create_pipster_object.R @@ -0,0 +1,65 @@ +welfare_gd <- pip_gd$L +weight_gd <- pip_gd$P +welfare_md <- pip_md_s$welfare +weight_md <- pip_md_s$weight + +#_______________________________________________________________________________ +# Tests +#_______________________________________________________________________________ + +test_that("create_pipster_object - errors", { + + expect_error( + create_pipster_object(welfare = c(welfare_gd[1], + NA, + welfare_gd[2:length(welfare_gd)]), + weight = weight_gd)) + + expect_error( + create_pipster_object(welfare = LETTERS, + weight = c(weight_gd[1], + NA, + weight_gd[2:length(weight_gd)]))) + expect_error( + create_pipster_object(welfare = welfare_gd, + weight = c(weight_gd[1], + NA, + weight_gd[3:length(weight_gd)]))) + + +}) + + +test_that("create_pipster_object - correct class identified", { + + obj1 <- create_pipster_object(welfare = welfare_gd, + weight = weight_gd) + obj2 <- create_pipster_object(welfare = welfare_md, + weight = weight_md) + obj3 <- create_pipster_object(welfare = welfare_md, + weight = weight_md, + imputation_id = rep(c(1, 2), + length(weight_md)/2)) + + expect_equal(obj1$welfare |> class(), + c("pipster_gd", + "vctrs_vctr")) + expect_equal(obj2$welfare |> class(), + c("pipster_md", + "vctrs_vctr")) + expect_equal(obj3$welfare |> class(), + c("pipster_md", + "vctrs_vctr")) + expect_true( + length(obj3$imputation_id |> + funique()) == # imputation id works + 2*length(obj2$imputation_id |> + funique())) + + +}) + + + + + diff --git a/tests/testthat/test-get_dist.R b/tests/testthat/test-get_dist.R new file mode 100644 index 0000000..838ff6b --- /dev/null +++ b/tests/testthat/test-get_dist.R @@ -0,0 +1,263 @@ +gd_object <- create_pipster_object(welfare = pip_gd$L, + weight = pip_gd$P) +md_object <- create_pipster_object(welfare = pip_md_s$welfare, + weight = pip_md_s$weight) +welfare_gd <- pip_gd$L +weight_gd <- pip_gd$P +welfare_md <- pip_md_s$welfare +weight_md <- pip_md_s$weight + +#_______________________________________________________________________________ +# Tests +#_______________________________________________________________________________ + + +test_that("get_quantile works", { + + # standard + out1_gd <- get_quantile(pipster_object = gd_object) + out1_md <- get_quantile(pipster_object = md_object) + out2_gd <- pipgd_quantile(welfare = welfare_gd, + weight = weight_gd) + out2_md <- pipmd_quantile(welfare = welfare_md, + weight = weight_md, + format = "list") + + expect_equal(out1_gd |> unlist() |> unname(), + out2_gd$dist_stats$quantile) + expect_equal(out1_md, + out2_md) + + # use arguments - n + out1_gd <- get_quantile(pipster_object = gd_object, + n = 5) + out1_md <- get_quantile(pipster_object = md_object, + n = 5) + out2_gd <- pipgd_quantile(welfare = welfare_gd, + weight = weight_gd, + n = 5) + out2_md <- pipmd_quantile(welfare = welfare_md, + weight = weight_md, + n = 5, + format = "list") + + expect_equal(out1_gd |> unlist() |> unname(), + out2_gd$dist_stats$quantile) + expect_equal(out1_md, + out2_md) + + # use arguments - popshare + out1_gd <- get_quantile(pipster_object = gd_object, + popshare = 0.5) + out1_md <- get_quantile(pipster_object = md_object, + popshare = 0.5) + out2_gd <- pipgd_quantile(welfare = welfare_gd, + weight = weight_gd, + popshare = 0.5) + out2_md <- pipmd_quantile(welfare = welfare_md, + weight = weight_md, + popshare = 0.5, + format = "list") + + expect_equal(names(out1_gd), "50%") + expect_equal(out1_gd |> unlist() |> unname(), + out2_gd$dist_stats$quantile) + expect_equal(out1_md, + out2_md) + +}) + + + +test_that("get_welfare_share_at works", { + + # standard + out1_gd <- get_welfare_share_at(pipster_object = gd_object) + out1_md <- get_welfare_share_at(pipster_object = md_object) + out2_gd <- pipgd_welfare_share_at(welfare = welfare_gd, + weight = weight_gd) + out2_md <- pipmd_welfare_share_at(welfare = welfare_md, + weight = weight_md, + format = "list") + + expect_equal(out1_gd |> unlist() |> unname(), + out2_gd$dist_stats$welfare_share_at) + expect_equal(out1_md, + out2_md) + + # use arguments - n + out1_gd <- get_welfare_share_at(pipster_object = gd_object, + n = 5) + out1_md <- get_welfare_share_at(pipster_object = md_object, + n = 5) + out2_gd <- pipgd_welfare_share_at(welfare = welfare_gd, + weight = weight_gd, + n = 5) + out2_md <- pipmd_welfare_share_at(welfare = welfare_md, + weight = weight_md, + n = 5, + format = "list") + + expect_equal(out1_gd |> unlist() |> unname(), + out2_gd$dist_stats$welfare_share_at) + expect_equal(out1_md, + out2_md) + + # use arguments - popshare + out1_gd <- get_welfare_share_at(pipster_object = gd_object, + popshare = 0.4) + out1_md <- get_welfare_share_at(pipster_object = md_object, + popshare = 0.4) + out2_gd <- pipgd_welfare_share_at(welfare = welfare_gd, + weight = weight_gd, + popshare = 0.4) + out2_md <- pipmd_welfare_share_at(welfare = welfare_md, + weight = weight_md, + popshare = 0.4, + format = "list") + + expect_equal(names(out1_gd), "40%") + expect_equal(out1_gd |> unlist() |> unname(), + out2_gd$dist_stats$welfare_share_at) + expect_equal(out1_md, + out2_md) + +}) + + + +test_that("get_quantile_welfare_share works", { + + # standard + out1_gd <- get_quantile_welfare_share(pipster_object = gd_object) + out1_md <- get_quantile_welfare_share(pipster_object = md_object) + out2_gd <- pipgd_quantile_welfare_share(welfare = welfare_gd, + weight = weight_gd) + out2_md <- pipmd_quantile_welfare_share(welfare = welfare_md, + weight = weight_md, + format = "list") + + expect_equal(out1_gd |> unlist() |> unname(), + out2_gd$dist_stats$quantile_welfare_share) + expect_equal(out1_md, + out2_md) + + # use arguments - n + out1_gd <- get_quantile_welfare_share(pipster_object = gd_object, + n = 5) + out1_md <- get_quantile_welfare_share(pipster_object = md_object, + n = 5) + out2_gd <- pipgd_quantile_welfare_share(welfare = welfare_gd, + weight = weight_gd, + n = 5) + out2_md <- pipmd_quantile_welfare_share(welfare = welfare_md, + weight = weight_md, + n = 5, + format = "list") + + expect_equal(out1_gd |> unlist() |> unname(), + out2_gd$dist_stats$quantile_welfare_share) + expect_equal(out1_md, + out2_md) + + # use arguments - popshare + out1_gd <- get_quantile_welfare_share(pipster_object = gd_object, + popshare = 0.4, + n = NULL) + out1_md <- get_quantile_welfare_share(pipster_object = md_object, + popshare = 0.4, + n = NULL) + out2_gd <- pipgd_quantile_welfare_share(welfare = welfare_gd, + weight = weight_gd, + popshare = 0.4, + n = NULL) + out2_md <- pipmd_quantile_welfare_share(welfare = welfare_md, + weight = weight_md, + popshare = 0.4, + format = "list", + n = NULL) + + expect_equal(names(out1_gd), "40%") + expect_equal(out1_gd |> unlist() |> unname(), + out2_gd$dist_stats$quantile_welfare_share) + expect_equal(out1_md, + out2_md) + +}) + + + +test_that("get_gini works", { + + # standard + out1_gd <- get_gini(pipster_object = gd_object) + out1_md <- get_gini(pipster_object = md_object) + out2_gd <- pipgd_gini(welfare = welfare_gd, + weight = weight_gd) + out2_md <- pipmd_gini(welfare = welfare_md, + weight = weight_md, + format = "list") + + expect_equal(out1_gd$gini , + out2_gd$dist_stats$gini) + expect_equal(out1_md, + out2_md) + + +}) + + +test_that("get_polarization works", { + + # standard + #out1_gd <- get_polarization(pipster_object = gd_object) + out1_md <- get_polarization(pipster_object = md_object) + #out2_gd <- pipgd_polarization(welfare = welfare_gd, + # weight = weight_gd) + out2_md <- pipmd_polarization(welfare = welfare_md, + weight = weight_md, + format = "list") + + #expect_equal(out1_gd$polarization , + # out2_gd$dist_stats$polarization) + expect_equal(out1_md, + out2_md) + +}) + + + + + +test_that("get_mld works", { + + # standard + out1_gd <- get_mld(pipster_object = gd_object) + out1_md <- get_mld(pipster_object = md_object) + out2_gd <- pipgd_mld(welfare = welfare_gd, + weight = weight_gd) + out2_md <- pipmd_mld(welfare = welfare_md, + weight = weight_md, + format = "list") + + expect_equal(out1_gd$mld , + out2_gd$dist_stats$mld) + expect_equal(out1_md, + out2_md) + +}) + + + + + + + + + + + + + + + diff --git a/tests/testthat/test-pipgd_params.R b/tests/testthat/test-pipgd_params.R index ce6f1b7..d5779c3 100644 --- a/tests/testthat/test-pipgd_params.R +++ b/tests/testthat/test-pipgd_params.R @@ -107,7 +107,7 @@ test_that("check_pipgd_params aborts on invalid params", { lp <- list( params = structure(c(1, 2, 3), class = "pipgd_params"), welfare = NULL, - population = c(1, 2, 3) # This can be omitted or included + weight = c(1, 2, 3) # This can be omitted or included ) expect_error(check_pipgd_params(lp)) diff --git a/tests/testthat/test-pipster_gd.R b/tests/testthat/test-pipster_gd.R new file mode 100644 index 0000000..c43969a --- /dev/null +++ b/tests/testthat/test-pipster_gd.R @@ -0,0 +1,96 @@ + +# Testing new_pipster_gd and pipster_gd functions +test_that("new_pipster_gd and pipster_gd work correctly", { + # Test for normal input + v <- pipster_gd(c(0.1, 0.5, 0.9, 1)) + expect_s3_class(v, "pipster_gd") + expect_equal(v |> unclass(), c(0.1, 0.5, 0.9, 1)) + + # Test for edge cases like empty vector and NA + v_empty <- pipster_gd(numeric(0)) + expect_s3_class(v_empty, "pipster_gd") + expect_equal(v_empty |> unclass(), numeric(0)) + + v_na <- pipster_gd(NA) + expect_s3_class(v_na, "pipster_gd") + expect_true(all(is.na(v_na))) +}) + +# Testing is_pipster_gd function +test_that("is_pipster_gd identifies pipster_gd objects correctly", { + expect_true(is_pipster_gd(pipster_gd(1:5))) + expect_false(is_pipster_gd(1:5)) + expect_false(is_pipster_gd("not a pipster_gd")) +}) + +# Testing as_pipster_gd function +test_that("as_pipster_gd casts correctly", { + v <- as_pipster_gd(as.double(c(1:5))) + expect_s3_class(v, "pipster_gd") + + # Testing with invalid input + expect_error(as_pipster_gd("invalid")) +}) + +# Testing format.pipster_gd function +test_that("format.pipster_gd formats correctly", { + v <- format(pipster_gd(c(0.12345, 0.67890))) + expect_equal(v, c("0.123", "0.679")) +}) + +# Testing vec_ptype_abbr.pipster_gd function +test_that("vec_ptype_abbr.pipster_gd returns correct abbreviation", { + expect_equal(vec_ptype_abbr.pipster_gd(pipster_gd()), "pipgd") +}) + +# Testing vector casting functions +test_that("vector casting functions work correctly", { + # pipster_gd to pipster_gd + v_md <- vec_cast.pipster_gd.pipster_gd(pipster_gd(1:5), new_pipster_gd()) + expect_s3_class(v_md, "pipster_gd") + + v_double <- vec_cast.pipster_gd.double(pipster_gd(1:5), double()) + expect_s3_class(v_double, "pipster_gd") + + v_cast_double <- vec_cast.double.pipster_gd(1:5, new_pipster_gd()) + expect_failure(expect_s3_class((v_cast_double), "pipster_gd")) +}) + +# Testing arithmetic functions +test_that("arithmetic functions work correctly", { + x <- pipster_gd(c(1, 2)) + y <- pipster_gd(c(3, 4)) + + # Test addition + expect_equal(vec_arith.pipster_gd("+", x, y), pipster_gd(c(4, 6))) + + # Test subtraction + expect_equal(vec_arith.pipster_gd("-", x, y), pipster_gd(c(-2, -2))) + + # Test multiplication + expect_equal(vec_arith.pipster_gd("*", x, y), pipster_gd(c(3, 8))) + + # Test division + expect_equal(vec_arith.pipster_gd("/", x, y), pipster_gd(c(1/3, 2/4))) + + # Test with numeric + z <- c(5, 6) + expect_equal(vec_arith.pipster_gd("+", x, z), pipster_gd(c(6, 8))) + + # Test incompatible operations + expect_error(vec_arith.pipster_gd("%", x, y)) +}) + +# Testing vec_math.pipster_gd function +test_that("vec_math.pipster_gd handles mathematical operations", { + v <- pipster_gd(c(1, 2, 3, 4)) + expect_equal(vec_math.pipster_gd("sum", v), sum(v)) + expect_equal(vec_math.pipster_gd("mean", v), mean(v)) +}) + +# Testing default_warning_message function +test_that("default_warning_message generates correct message", { + expect_warning(default_warning_message("test_generic", "non_pipster_gd"), + "test_generic does not know how to handle object of class") +}) + diff --git a/tests/testthat/test-pipster_md.R b/tests/testthat/test-pipster_md.R new file mode 100644 index 0000000..39aaced --- /dev/null +++ b/tests/testthat/test-pipster_md.R @@ -0,0 +1,97 @@ + +# Testing new_pipster_md and pipster_md functions +test_that("new_pipster_md and pipster_md work correctly", { + # Test for normal input + v <- pipster_md(c(0.1, 0.5, 0.9, 1)) + expect_s3_class(v, "pipster_md") + expect_equal(v |> unclass(), c(0.1, 0.5, 0.9, 1)) + + # Test for edge cases like empty vector and NA + v_empty <- pipster_md(numeric(0)) + expect_s3_class(v_empty, "pipster_md") + expect_equal(v_empty |> unclass(), numeric(0)) + + v_na <- pipster_md(NA) + expect_s3_class(v_na, "pipster_md") + expect_true(all(is.na(v_na))) +}) + +# Testing is_pipster_md function +test_that("is_pipster_md identifies pipster_md objects correctly", { + expect_true(is_pipster_md(pipster_md(1:5))) + expect_false(is_pipster_md(1:5)) + expect_false(is_pipster_md("not a pipster_md")) +}) + +# Testing as_pipster_md function +test_that("as_pipster_md casts correctly", { + v <- as_pipster_md(as.double(c(1:5))) + expect_s3_class(v, "pipster_md") + + # Testing with invalid input + expect_error(as_pipster_md("invalid")) +}) + +# Testing format.pipster_md function +test_that("format.pipster_md formats correctly", { + v <- format(pipster_md(c(0.12345, 0.67890))) + expect_equal(v, c("0.123", "0.679")) +}) + +# Testing vec_ptype_abbr.pipster_md function +test_that("vec_ptype_abbr.pipster_md returns correct abbreviation", { + expect_equal(vec_ptype_abbr.pipster_md(pipster_md()), "pipmd") +}) + +# Testing vector casting functions +test_that("vector casting functions work correctly", { + # pipster_md to pipster_md + v_md <- vec_cast.pipster_md.pipster_md(pipster_md(1:5), new_pipster_md()) + expect_s3_class(v_md, "pipster_md") + + v_double <- vec_cast.pipster_md.double(pipster_md(1:5), double()) + expect_s3_class(v_double, "pipster_md") + + v_cast_double <- vec_cast.double.pipster_md(1:5, new_pipster_md()) + expect_failure(expect_s3_class((v_cast_double), "pipster_md")) +}) + +# Testing arithmetic functions +test_that("arithmetic functions work correctly", { + x <- pipster_md(c(1, 2)) + y <- pipster_md(c(3, 4)) + + # Test addition + expect_equal(vec_arith.pipster_md("+", x, y), pipster_md(c(4, 6))) + + # Test subtraction + expect_equal(vec_arith.pipster_md("-", x, y), pipster_md(c(-2, -2))) + + # Test multiplication + expect_equal(vec_arith.pipster_md("*", x, y), pipster_md(c(3, 8))) + + # Test division + expect_equal(vec_arith.pipster_md("/", x, y), pipster_md(c(1/3, 2/4))) + + # Test with numeric + z <- c(5, 6) + expect_equal(vec_arith.pipster_md("+", x, z), pipster_md(c(6, 8))) + + # Test incompatible operations + expect_error(vec_arith.pipster_md("%", x, y)) +}) + +# Testing vec_math.pipster_md function +test_that("vec_math.pipster_md handles mathematical operations", { + v <- pipster_md(c(1, 2, 3, 4)) + expect_equal(vec_math.pipster_md("sum", v), sum(v)) + expect_equal(vec_math.pipster_md("mean", v), mean(v)) +}) + +# Testing default_warning_message function +test_that("default_warning_message generates correct message", { + expect_warning(default_warning_message("test_generic", "non_pipster_md"), + "test_generic does not know how to handle object of class") +}) + + From 4cd07c54775040c3416ee5f3b4fc5f0a89b840e0 Mon Sep 17 00:00:00 2001 From: RossanaTat Date: Wed, 14 Feb 2024 21:53:10 -0500 Subject: [PATCH 24/29] fix gini in polarization #att1 --- R/pipgd_dist.R | 38 ++++++++++++++++++++++++++++++-------- R/pipgd_params.R | 2 +- 2 files changed, 31 insertions(+), 9 deletions(-) diff --git a/R/pipgd_dist.R b/R/pipgd_dist.R index 68b4c01..8b59c97 100644 --- a/R/pipgd_dist.R +++ b/R/pipgd_dist.R @@ -588,11 +588,13 @@ pipgd_polarization <- function( # Params # _________________________________________________________________ + # If the user supplies welfare and weight vectors if (!is.null(welfare)) { - params <- pipgd_select_lorenz( + params <- pipgd_gini( welfare = welfare, weight = weight, - complete = TRUE + complete = TRUE, + lorenz = lorenz ) } @@ -609,19 +611,38 @@ pipgd_polarization <- function( # Set arguments # _________________________________________________________________ - # Gini - if (is.null(gini)) { - gini <- pipgd_gini(welfare = params$data$welfare, - weight = params$data$weight, - lorenz = lorenz)$dist_stats$gini + + # Calculations ------------------------------------------------ + # TODO: combine this with the case !is.null(welfare) + if (is.null(gini) | is.null(params$dist_stats$gini)) { + params <- pipgd_gini( + welfare = params$data$welfare, + weight = params$data$weight, + complete = TRUE, + lorenz = lorenz + ) + } + + + # Getting the gini ------------------------------------------------ + + if (!is.null(gini)) { + gini <- gini + } else { + gini <- params$dist_stats$gini } # Set arguments p0 <- 0.5 # constant + + # Mean + # TODO + mean = mean + dcm <- (1 - gini)*mean # Compute polarization index - polarization_ <- paste0("wbpip::gd_compute_polarization_", + polarization_ <- paste0("wbpip:::gd_compute_polarization_", lorenz) |> parse(text = _) @@ -644,6 +665,7 @@ pipgd_polarization <- function( params <- vector("list") } + params$dist_stats$gini <- gini params$dist_stats$polarization <- polarization params$dist_stats$lorenz <- lorenz diff --git a/R/pipgd_params.R b/R/pipgd_params.R index 048c992..a015332 100644 --- a/R/pipgd_params.R +++ b/R/pipgd_params.R @@ -54,7 +54,7 @@ #' pipgd_params <- function(welfare, weight, - mean = NULL, + mean = 1, population = NULL) { # ____________________________________________________________________________ From 350f39e35135e7a3ca67cc22191ef0bca7166678 Mon Sep 17 00:00:00 2001 From: zander-prinsloo Date: Fri, 16 Feb 2024 11:32:09 -0500 Subject: [PATCH 25/29] update documentation --- NAMESPACE | 3 ++- R/get_dist.R | 9 ++++++--- R/get_pov.R | 4 ++++ R/pipmd_pov.R | 8 +++++--- man/get_gini.Rd | 2 ++ man/get_mld.Rd | 2 ++ man/get_polarization.Rd | 2 ++ man/get_pov_gap.Rd | 2 ++ man/get_pov_headcount.Rd | 2 ++ man/get_pov_severity.Rd | 2 ++ man/get_quantile.Rd | 2 ++ man/get_quantile_welfare_share.Rd | 2 ++ man/get_watts.Rd | 2 ++ man/get_welfare_share_at.Rd | 2 ++ man/pipgd_pov_severity_nv.Rd | 2 +- man/pipgd_watts.Rd | 2 +- man/pipgd_watts_nv.Rd | 2 +- man/pipmd_pov_gap.Rd | 2 ++ man/pipmd_pov_gap_nv.Rd | 2 ++ man/pipmd_pov_headcount.Rd | 2 ++ man/pipmd_pov_headcount_nv.Rd | 2 ++ man/pipmd_pov_severity.Rd | 2 ++ man/pipmd_pov_severity_nv.Rd | 2 ++ man/pipmd_watts.Rd | 2 ++ man/pipmd_watts_nv.Rd | 2 ++ man/pipster_gd.Rd | 4 ++-- man/pipster_md.Rd | 6 +++--- man/validate_params.Rd | 13 +------------ 28 files changed, 62 insertions(+), 27 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index d178eb3..ccbc76d 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -62,8 +62,9 @@ S3method(vec_ptype2,pipster_md.integer) S3method(vec_ptype2,pipster_md.pipster_md) S3method(vec_ptype_abbr,pipster_gd) S3method(vec_ptype_abbr,pipster_md) -export(as_percent) export(as_pip) +export(as_pipster_gd) +export(as_pipster_md) export(create_pipster_object) export(get_gini) export(get_mld) diff --git a/R/get_dist.R b/R/get_dist.R index 91f1413..d168378 100644 --- a/R/get_dist.R +++ b/R/get_dist.R @@ -8,6 +8,7 @@ #' #' @param pipster_object pipster object created using [create_pipster_object] #' @inheritParams pipgd_quantile +#' @param ... additional arguments passed to methods #' #' @return list #' @export @@ -119,6 +120,7 @@ get_quantile.default <- #' #' @param pipster_object pipster object created using [create_pipster_object] #' @inheritParams pipgd_welfare_share_at +#' @param ... additional arguments passed to methods #' #' @return list #' @export @@ -243,6 +245,7 @@ get_welfare_share_at.default <- #' #' @param pipster_object pipster object created using [create_pipster_object] #' @inheritParams pipgd_quantile_welfare_share +#' @param ... additional arguments passed to methods #' #' @return list #' @export @@ -369,7 +372,7 @@ get_quantile_welfare_share.default <- #' This is a generic function calculating the gini coefficient. #' #' @param pipster_object pipster object created using [create_pipster_object] -#' @inheritParams pipgd_gini +#' @param ... additional arguments passed to methods #' #' @return list #' @export @@ -463,7 +466,7 @@ get_gini.default <- #' This is a generic function to compute the Wolfson polarization index. #' #' @param pipster_object pipster object created using [create_pipster_object] -#' @inheritParams pipmd_polarization +#' @param ... additional arguments passed to methods #' #' @return list #' @export @@ -558,7 +561,7 @@ get_polarization.default <- #' Mean Log Deviation (MLD). #' #' @param pipster_object pipster object created using [create_pipster_object] -#' @inheritParams pipmd_mld +#' @param ... additional arguments passed to methods #' #' @return list #' @export diff --git a/R/get_pov.R b/R/get_pov.R index e1a7a4b..33a6002 100644 --- a/R/get_pov.R +++ b/R/get_pov.R @@ -10,6 +10,7 @@ #' #' @param pipster_object pipster object created using [create_pipster_object] #' @inheritParams pipmd_pov_headcount +#' @param ... additional arguments passed to methods #' #' @return list #' @export @@ -130,6 +131,7 @@ get_pov_headcount.default <- #' #' @param pipster_object pipster object created using [create_pipster_object] #' @inheritParams pipmd_pov_gap +#' @param ... additional arguments passed to methods #' #' @return list #' @export @@ -229,6 +231,7 @@ get_pov_gap.default <- #' #' @param pipster_object pipster object created using [create_pipster_object] #' @inheritParams pipmd_pov_severity +#' @param ... additional arguments passed to methods #' #' @return list #' @export @@ -328,6 +331,7 @@ get_pov_severity.default <- #' #' @param pipster_object pipster object created using [create_pipster_object] #' @inheritParams pipmd_watts +#' @param ... additional arguments passed to methods #' #' @return list #' @export diff --git a/R/pipmd_pov.R b/R/pipmd_pov.R index 621203f..53f1c28 100644 --- a/R/pipmd_pov.R +++ b/R/pipmd_pov.R @@ -8,6 +8,7 @@ #' Non-vectorized poverty headcount microdata function. Use the vectorized #' function [pipmd_pov_headcount] #' +#' @param pipster_object pipster object created using [create_pipster_object] #' @param welfare numeric: A vector of income or consumption values #' @param weight numeric: A vector of population weights. If NULL, a vector of 1s #' is used to give equal weight to each observation. @@ -19,9 +20,9 @@ pipmd_pov_headcount_nv <- function( pipster_object = NULL, welfare = NULL, - weight = rep(1, length = length(welfare)), - povline = fmean(welfare, w = weight)*times_mean, - times_mean = 1 + weight = rep(1, length = length(welfare)), + povline = fmean(welfare, w = weight)*times_mean, + times_mean = 1 ){ # Defenses ------------- @@ -177,6 +178,7 @@ pipmd_pov_gap_nv <- function( #' Calculate poverty gap from microdata #' +#' @param pipster_object pipster object created using [create_pipster_object] #' @inheritParams pipmd_pov_gap_nv #' @param format atomic character vector: specifies the format of output, either #' "dt", "list", or "atomic" diff --git a/man/get_gini.Rd b/man/get_gini.Rd index 4dc79de..4421acb 100644 --- a/man/get_gini.Rd +++ b/man/get_gini.Rd @@ -8,6 +8,8 @@ get_gini(pipster_object, ...) } \arguments{ \item{pipster_object}{pipster object created using \link{create_pipster_object}} + +\item{...}{additional arguments passed to methods} } \value{ list diff --git a/man/get_mld.Rd b/man/get_mld.Rd index 920ead5..dba8341 100644 --- a/man/get_mld.Rd +++ b/man/get_mld.Rd @@ -8,6 +8,8 @@ get_mld(pipster_object, ...) } \arguments{ \item{pipster_object}{pipster object created using \link{create_pipster_object}} + +\item{...}{additional arguments passed to methods} } \value{ list diff --git a/man/get_polarization.Rd b/man/get_polarization.Rd index 1857802..f673e3f 100644 --- a/man/get_polarization.Rd +++ b/man/get_polarization.Rd @@ -8,6 +8,8 @@ get_polarization(pipster_object, ...) } \arguments{ \item{pipster_object}{pipster object created using \link{create_pipster_object}} + +\item{...}{additional arguments passed to methods} } \value{ list diff --git a/man/get_pov_gap.Rd b/man/get_pov_gap.Rd index 8ca5e55..6d97762 100644 --- a/man/get_pov_gap.Rd +++ b/man/get_pov_gap.Rd @@ -10,6 +10,8 @@ get_pov_gap(pipster_object, povline, ...) \item{pipster_object}{pipster object created using \link{create_pipster_object}} \item{povline}{numeric: Poverty line in international dollars, same units as welfare.} + +\item{...}{additional arguments passed to methods} } \value{ list diff --git a/man/get_pov_headcount.Rd b/man/get_pov_headcount.Rd index d78e2a6..2e9f189 100644 --- a/man/get_pov_headcount.Rd +++ b/man/get_pov_headcount.Rd @@ -10,6 +10,8 @@ get_pov_headcount(pipster_object, povline, ...) \item{pipster_object}{pipster object created using \link{create_pipster_object}} \item{povline}{numeric: Poverty line in international dollars, same units as welfare.} + +\item{...}{additional arguments passed to methods} } \value{ list diff --git a/man/get_pov_severity.Rd b/man/get_pov_severity.Rd index 7581558..471d071 100644 --- a/man/get_pov_severity.Rd +++ b/man/get_pov_severity.Rd @@ -10,6 +10,8 @@ get_pov_severity(pipster_object, povline, ...) \item{pipster_object}{pipster object created using \link{create_pipster_object}} \item{povline}{numeric: Poverty line in international dollars, same units as welfare.} + +\item{...}{additional arguments passed to methods} } \value{ list diff --git a/man/get_quantile.Rd b/man/get_quantile.Rd index 34c2295..b26f98f 100644 --- a/man/get_quantile.Rd +++ b/man/get_quantile.Rd @@ -17,6 +17,8 @@ get_quantile( \item{n}{numeric scalar for the number of quantiles to be used in \code{popshare}} \item{popshare}{numeric: vector of share of population. Default is \code{seq(from = 1/n, to = 1, by = 1/n)}} + +\item{...}{additional arguments passed to methods} } \value{ list diff --git a/man/get_quantile_welfare_share.Rd b/man/get_quantile_welfare_share.Rd index 8235881..6542a13 100644 --- a/man/get_quantile_welfare_share.Rd +++ b/man/get_quantile_welfare_share.Rd @@ -17,6 +17,8 @@ get_quantile_welfare_share( \item{n}{numeric scalar for the number of quantiles to be used in \code{popshare}} \item{popshare}{numeric: vector of share of population. Default is \code{seq(from = 1/n, to = 1, by = 1/n)}} + +\item{...}{additional arguments passed to methods} } \value{ list diff --git a/man/get_watts.Rd b/man/get_watts.Rd index 2ed3bd0..79f0efc 100644 --- a/man/get_watts.Rd +++ b/man/get_watts.Rd @@ -10,6 +10,8 @@ get_watts(pipster_object, povline, ...) \item{pipster_object}{pipster object created using \link{create_pipster_object}} \item{povline}{numeric: Poverty line in international dollars, same units as welfare.} + +\item{...}{additional arguments passed to methods} } \value{ list diff --git a/man/get_welfare_share_at.Rd b/man/get_welfare_share_at.Rd index e1150d6..4025ef3 100644 --- a/man/get_welfare_share_at.Rd +++ b/man/get_welfare_share_at.Rd @@ -17,6 +17,8 @@ get_welfare_share_at( \item{n}{numeric scalar for the number of quantiles to be used in \code{popshare}} \item{popshare}{numeric: vector of share of population. Default is \code{seq(from = 1/n, to = 1, by = 1/n)}} + +\item{...}{additional arguments passed to methods} } \value{ list diff --git a/man/pipgd_pov_severity_nv.Rd b/man/pipgd_pov_severity_nv.Rd index b667653..b17d222 100644 --- a/man/pipgd_pov_severity_nv.Rd +++ b/man/pipgd_pov_severity_nv.Rd @@ -5,7 +5,7 @@ \title{Estimate poverty severity (non-vectorized)} \usage{ pipgd_pov_severity_nv( - pipster_object = pipster_object, + pipster_object = NULL, params = NULL, welfare = NULL, weight = NULL, diff --git a/man/pipgd_watts.Rd b/man/pipgd_watts.Rd index d553b01..e0c509a 100644 --- a/man/pipgd_watts.Rd +++ b/man/pipgd_watts.Rd @@ -5,7 +5,7 @@ \title{Estimate Watts poverty index} \usage{ pipgd_watts( - pipster_object = pipster_object, + pipster_object = NULL, params = NULL, welfare = NULL, weight = NULL, diff --git a/man/pipgd_watts_nv.Rd b/man/pipgd_watts_nv.Rd index 87028ae..15b03af 100644 --- a/man/pipgd_watts_nv.Rd +++ b/man/pipgd_watts_nv.Rd @@ -5,7 +5,7 @@ \title{Estimate Watts poverty index (non-vectorized)} \usage{ pipgd_watts_nv( - pipster_object = pipster_object, + pipster_object = NULL, params = NULL, welfare = NULL, weight = NULL, diff --git a/man/pipmd_pov_gap.Rd b/man/pipmd_pov_gap.Rd index d360d4b..b830a5e 100644 --- a/man/pipmd_pov_gap.Rd +++ b/man/pipmd_pov_gap.Rd @@ -14,6 +14,8 @@ pipmd_pov_gap( ) } \arguments{ +\item{pipster_object}{pipster object created using \link{create_pipster_object}} + \item{welfare}{numeric: A vector of income or consumption values} \item{weight}{numeric: A vector of population weights. If NULL, a vector of 1s diff --git a/man/pipmd_pov_gap_nv.Rd b/man/pipmd_pov_gap_nv.Rd index e1591c4..2a38656 100644 --- a/man/pipmd_pov_gap_nv.Rd +++ b/man/pipmd_pov_gap_nv.Rd @@ -13,6 +13,8 @@ pipmd_pov_gap_nv( ) } \arguments{ +\item{pipster_object}{pipster object created using \link{create_pipster_object}} + \item{welfare}{numeric: A vector of income or consumption values} \item{weight}{numeric: A vector of population weights. If NULL, a vector of 1s diff --git a/man/pipmd_pov_headcount.Rd b/man/pipmd_pov_headcount.Rd index f054aaf..cd0ed1a 100644 --- a/man/pipmd_pov_headcount.Rd +++ b/man/pipmd_pov_headcount.Rd @@ -14,6 +14,8 @@ pipmd_pov_headcount( ) } \arguments{ +\item{pipster_object}{pipster object created using \link{create_pipster_object}} + \item{welfare}{numeric: A vector of income or consumption values} \item{weight}{numeric: A vector of population weights. If NULL, a vector of 1s diff --git a/man/pipmd_pov_headcount_nv.Rd b/man/pipmd_pov_headcount_nv.Rd index df00842..b425158 100644 --- a/man/pipmd_pov_headcount_nv.Rd +++ b/man/pipmd_pov_headcount_nv.Rd @@ -13,6 +13,8 @@ pipmd_pov_headcount_nv( ) } \arguments{ +\item{pipster_object}{pipster object created using \link{create_pipster_object}} + \item{welfare}{numeric: A vector of income or consumption values} \item{weight}{numeric: A vector of population weights. If NULL, a vector of 1s diff --git a/man/pipmd_pov_severity.Rd b/man/pipmd_pov_severity.Rd index adc4b28..9d27892 100644 --- a/man/pipmd_pov_severity.Rd +++ b/man/pipmd_pov_severity.Rd @@ -14,6 +14,8 @@ pipmd_pov_severity( ) } \arguments{ +\item{pipster_object}{pipster object created using \link{create_pipster_object}} + \item{welfare}{numeric: A vector of income or consumption values} \item{weight}{numeric: A vector of population weights. If NULL, a vector of 1s diff --git a/man/pipmd_pov_severity_nv.Rd b/man/pipmd_pov_severity_nv.Rd index a2d3bd5..1326a6b 100644 --- a/man/pipmd_pov_severity_nv.Rd +++ b/man/pipmd_pov_severity_nv.Rd @@ -13,6 +13,8 @@ pipmd_pov_severity_nv( ) } \arguments{ +\item{pipster_object}{pipster object created using \link{create_pipster_object}} + \item{welfare}{numeric: A vector of income or consumption values} \item{weight}{numeric: A vector of population weights. If NULL, a vector of 1s diff --git a/man/pipmd_watts.Rd b/man/pipmd_watts.Rd index 091e14d..239d21a 100644 --- a/man/pipmd_watts.Rd +++ b/man/pipmd_watts.Rd @@ -14,6 +14,8 @@ pipmd_watts( ) } \arguments{ +\item{pipster_object}{pipster object created using \link{create_pipster_object}} + \item{welfare}{numeric: A vector of income or consumption values} \item{weight}{numeric: A vector of population weights. If NULL, a vector of 1s diff --git a/man/pipmd_watts_nv.Rd b/man/pipmd_watts_nv.Rd index ca4b1ca..8a03722 100644 --- a/man/pipmd_watts_nv.Rd +++ b/man/pipmd_watts_nv.Rd @@ -13,6 +13,8 @@ pipmd_watts_nv( ) } \arguments{ +\item{pipster_object}{pipster object created using \link{create_pipster_object}} + \item{welfare}{numeric: A vector of income or consumption values} \item{weight}{numeric: A vector of population weights. If NULL, a vector of 1s diff --git a/man/pipster_gd.Rd b/man/pipster_gd.Rd index 56f1f07..868d7fa 100644 --- a/man/pipster_gd.Rd +++ b/man/pipster_gd.Rd @@ -3,14 +3,14 @@ \name{pipster_gd} \alias{pipster_gd} \alias{is_pipster_gd} -\alias{as_percent} +\alias{as_pipster_gd} \title{\code{pipster_gd} vector} \usage{ pipster_gd(x = double()) is_pipster_gd(x) -as_percent(x) +as_pipster_gd(x) } \arguments{ \item{x}{\itemize{ diff --git a/man/pipster_md.Rd b/man/pipster_md.Rd index 33bb6d5..f307ea0 100644 --- a/man/pipster_md.Rd +++ b/man/pipster_md.Rd @@ -3,14 +3,14 @@ \name{pipster_md} \alias{pipster_md} \alias{is_pipster_md} -\alias{as_percent} +\alias{as_pipster_md} \title{\code{pipster_md} vector} \usage{ pipster_md(x = double()) is_pipster_md(x) -as_percent(x) +as_pipster_md(x) } \arguments{ \item{x}{\itemize{ @@ -23,7 +23,7 @@ as_percent(x) an S3 vector of class \code{pipster_md} } \description{ -This creates a double vector of group pipster data. +This creates a double vector of pipster micro data. } \examples{ pipster_md(c(0.1, 0.5, 0.9, 1)) diff --git a/man/validate_params.Rd b/man/validate_params.Rd index ab1e579..a1553b8 100644 --- a/man/validate_params.Rd +++ b/man/validate_params.Rd @@ -4,16 +4,7 @@ \alias{validate_params} \title{Validate group data parameters} \usage{ -validate_params( - pipster_object, - welfare, - weight, - params, - mean = 1, - times_mean = 1, - popshare = NULL, - povline = ifelse(is.null(popshare), mean * times_mean, NA_real_) -) +validate_params(pipster_object, welfare, weight, params) } \arguments{ \item{pipster_object}{pipster object created using \link{create_pipster_object}} @@ -23,8 +14,6 @@ validate_params( \item{weight}{numeric vector of cumulative share of the population} \item{params}{list of parameters from \code{pipgd_validate_lorenz()}} - -\item{popshare}{numeric: vector of share of population. Default is \code{seq(from = 1/n, to = 1, by = 1/n)}} } \value{ list: \code{params} to be used in gd functions From 317fb5068d724677ca537b3ef3257bb05f258997 Mon Sep 17 00:00:00 2001 From: zander-prinsloo Date: Fri, 16 Feb 2024 11:52:48 -0500 Subject: [PATCH 26/29] add pipster object to pipgd_polarization --- R/pipgd_dist.R | 91 ++++++++++++++++++++++---------------------------- 1 file changed, 40 insertions(+), 51 deletions(-) diff --git a/R/pipgd_dist.R b/R/pipgd_dist.R index b62c427..0022832 100644 --- a/R/pipgd_dist.R +++ b/R/pipgd_dist.R @@ -452,11 +452,11 @@ pipgd_gini <- function( #' pipgd_mld <- function( pipster_object = NULL, - params = NULL, - welfare = NULL, - weight = NULL, - complete = getOption("pipster.return_complete"), - lorenz = NULL + params = NULL, + welfare = NULL, + weight = NULL, + complete = getOption("pipster.return_complete"), + lorenz = NULL ){ # _________________________________________________________________ @@ -549,13 +549,14 @@ pipgd_mld <- function( #' complete = TRUE) #' pipgd_polarization <- function( - params = NULL, - welfare = NULL, - weight = NULL, - mean = 1, - gini = NULL, - complete = getOption("pipster.return_complete"), - lorenz = NULL + pipster_object = NULL, + params = NULL, + welfare = NULL, + weight = NULL, + mean = 1, + gini = NULL, + complete = getOption("pipster.return_complete"), + lorenz = NULL ){ # _________________________________________________________________ @@ -568,16 +569,32 @@ pipgd_polarization <- function( # Params # _________________________________________________________________ - # If the user supplies welfare and weight vectors - if (!is.null(welfare)) { - params <- pipgd_gini( - welfare = welfare, - weight = weight, - complete = TRUE, - lorenz = lorenz - ) + if (!is.null(pipster_object)) { + params <- pipgd_gini(pipster_object = pipster_object, + complete = TRUE, + lorenz = lorenz) + } else if (!is.null(welfare)) { + params <- pipgd_gini(welfare = welfare, + weight = weight, + complete = TRUE, + lorenz = lorenz) + } else { + params <- pipgd_gini(welfare = params$data$welfare, + weight = params$data$weight, + complete = TRUE, + lorenz = lorenz) } + # # If the user supplies welfare and weight vectors + # if (!is.null(welfare)) { + # params <- pipgd_gini( + # welfare = welfare, + # weight = weight, + # complete = TRUE, + # lorenz = lorenz + # ) + # } + # _________________________________________________________________ # Select Lorenz # _________________________________________________________________ @@ -587,39 +604,11 @@ pipgd_polarization <- function( match.arg(lorenz, c("lq", "lb")) } - # _________________________________________________________________ - # Set arguments - # _________________________________________________________________ - - - # Calculations ------------------------------------------------ - # TODO: combine this with the case !is.null(welfare) - if (is.null(gini) | is.null(params$dist_stats$gini)) { - params <- pipgd_gini( - welfare = params$data$welfare, - weight = params$data$weight, - complete = TRUE, - lorenz = lorenz - ) - } - - - # Getting the gini ------------------------------------------------ - - if (!is.null(gini)) { - gini <- gini - } else { - gini <- params$dist_stats$gini - } # Set arguments - p0 <- 0.5 # constant - - # Mean - # TODO - mean = mean - - dcm <- (1 - gini)*mean + p0 <- 0.5 # constant + mean <- params$data$mean + dcm <- (1 - params$dist_stats$gini)*mean # Compute polarization index polarization_ <- paste0("wbpip:::gd_compute_polarization_", From 8bebdeef6e996c632885166ae3ac3cd0ddf082f6 Mon Sep 17 00:00:00 2001 From: zander-prinsloo Date: Fri, 16 Feb 2024 14:40:40 -0500 Subject: [PATCH 27/29] add args to feed to pipgd_select_lorenz --- R/pipgd_dist.R | 107 ++++++++++++++++++++++++++++++------------------- 1 file changed, 66 insertions(+), 41 deletions(-) diff --git a/R/pipgd_dist.R b/R/pipgd_dist.R index 0022832..53015db 100644 --- a/R/pipgd_dist.R +++ b/R/pipgd_dist.R @@ -16,6 +16,7 @@ #' @param popshare numeric: vector of share of population. Default is `seq(from #' = 1/n, to = 1, by = 1/n)` #' @param n numeric scalar for the number of quantiles to be used in `popshare` +#' @param ... additional arguments for [pipgd_select_lorenz] #' #' @return Returns a nested list containing distribution statistics: #' `$dist_stats$pop_share` is a numeric vector containing the share of the @@ -66,7 +67,8 @@ pipgd_welfare_share_at <- function( complete = getOption("pipster.return_complete"), lorenz = NULL, n = 10, - popshare = seq(from = 1/n, to = 1, by = 1/n) + popshare = seq(from = 1/n, to = 1, by = 1/n), + ... ) { # ____________________________________________________________________________ @@ -79,7 +81,10 @@ pipgd_welfare_share_at <- function( params <- validate_params(pipster_object = pipster_object, welfare = welfare, weight = weight, - params = params) + params = params, + popshare = popshare, + ... + ) if (is.null(lorenz)) { lorenz <- params$selected_lorenz$for_dist @@ -121,6 +126,7 @@ pipgd_welfare_share_at <- function( #' the proportion of welfare that only the specified quantile holds. #' #' @inheritParams pipgd_welfare_share_at +#' @param ... additional arguments for [pipgd_select_lorenz] #' #' @return Returns a nested list containing distribution statistics: #' `$dist_stats$pop_share` is a numeric vector containing the share of the @@ -170,7 +176,8 @@ pipgd_quantile_welfare_share <- complete = getOption("pipster.return_complete"), lorenz = NULL, n = 10, - popshare = seq(from = 1/n, to = 1, by = 1/n)) { + popshare = seq(from = 1/n, to = 1, by = 1/n), + ...) { # _________________________________________________________________ # Defenses #### @@ -182,7 +189,9 @@ pipgd_quantile_welfare_share <- params <- validate_params(pipster_object = pipster_object, welfare = welfare, weight = weight, - params = params) + params = params, + popshare = popshare, + ...) if (is.null(lorenz)) { lorenz <- params$selected_lorenz$for_dist @@ -280,9 +289,9 @@ pipgd_quantile <- weight = NULL, n = 10, popshare = seq(from = 1/n, to = 1, by = 1/n), - mean = 1, complete = getOption("pipster.return_complete"), - lorenz = NULL) { + lorenz = NULL, + ...) { # _________________________________________________________________ # Defenses #### @@ -294,7 +303,10 @@ pipgd_quantile <- params <- validate_params(pipster_object = pipster_object, welfare = welfare, weight = weight, - params = params) + params = params, + times_mean = times_mean, + popshare = popshare, + ...) if (is.null(lorenz)) { lorenz <- params$selected_lorenz$for_dist @@ -327,6 +339,7 @@ pipgd_quantile <- #' functions. #' #' @inheritParams pipgd_pov_headcount_nv +#' @param ... additional arguments for [pipgd_select_lorenz] #' #' @return Returns a nested list containing distribution statistics: #' `$dist_stats$gini` is a numeric vector containing the gini coefficient. @@ -356,7 +369,8 @@ pipgd_gini <- function( welfare = NULL, weight = NULL, complete = getOption("pipster.return_complete"), - lorenz = NULL + lorenz = NULL, + ... ){ # _________________________________________________________________ @@ -371,7 +385,8 @@ pipgd_gini <- function( params <- validate_params(pipster_object = pipster_object, welfare = welfare, weight = weight, - params = params) + params = params, + ...) # _________________________________________________________________ # Select Lorenz @@ -426,6 +441,7 @@ pipgd_gini <- function( #' quadratic Lorenz functions. #' #' @inheritParams pipgd_gini +#' @param ... additional arguments for [pipgd_select_lorenz] #' #' @return Returns a nested list containing distribution statistics: #' `$dist_stats$mld` is a numeric vector containing the mld calculation. @@ -456,7 +472,8 @@ pipgd_mld <- function( welfare = NULL, weight = NULL, complete = getOption("pipster.return_complete"), - lorenz = NULL + lorenz = NULL, + ... ){ # _________________________________________________________________ @@ -471,7 +488,8 @@ pipgd_mld <- function( params <- validate_params(pipster_object = pipster_object, welfare = welfare, weight = weight, - params = params) + params = params, + ...) # _________________________________________________________________ # Select Lorenz @@ -569,22 +587,29 @@ pipgd_polarization <- function( # Params # _________________________________________________________________ - if (!is.null(pipster_object)) { - params <- pipgd_gini(pipster_object = pipster_object, - complete = TRUE, - lorenz = lorenz) - } else if (!is.null(welfare)) { - params <- pipgd_gini(welfare = welfare, - weight = weight, - complete = TRUE, - lorenz = lorenz) - } else { - params <- pipgd_gini(welfare = params$data$welfare, - weight = params$data$weight, - complete = TRUE, - lorenz = lorenz) + if (is.null(gini)) { + if (!is.null(pipster_object)) { + params <- pipgd_gini(pipster_object = pipster_object, + complete = TRUE, + lorenz = lorenz, + mean = mean) + } else if (!is.null(welfare)) { + params <- pipgd_gini(welfare = welfare, + weight = weight, + complete = TRUE, + lorenz = lorenz, + mean = mean) + } else { + params <- pipgd_gini(welfare = params$data$welfare, + weight = params$data$weight, + complete = TRUE, + lorenz = lorenz, + mean = mean) + } + gini <- params$dist_stats$gini } + # # If the user supplies welfare and weight vectors # if (!is.null(welfare)) { # params <- pipgd_gini( @@ -608,7 +633,7 @@ pipgd_polarization <- function( # Set arguments p0 <- 0.5 # constant mean <- params$data$mean - dcm <- (1 - params$dist_stats$gini)*mean + dcm <- (1 - gini)*mean # Compute polarization index polarization_ <- paste0("wbpip:::gd_compute_polarization_", @@ -654,11 +679,11 @@ validate_params <- function( pipster_object, welfare, weight, - params - #mean = 1, - #times_mean = 1, - #popshare = NULL, - #povline = ifelse(is.null(popshare), mean * times_mean, NA_real_) + params, + mean = 1, + times_mean = 1, + popshare = NULL, + povline = ifelse(is.null(popshare), mean * times_mean, NA_real_) ){ if (!is.null(pipster_object)) { @@ -668,19 +693,19 @@ validate_params <- function( } else if (!is.null(welfare)) { params <- pipgd_select_lorenz(welfare = welfare, weight = weight, - complete = TRUE) - # mean = mean, - # times_mean = times_mean, - # popshare = popshare, - # povline = povline) + complete = TRUE, + mean = mean, + times_mean = times_mean, + popshare = popshare, + povline = povline) } else { params <- pipgd_select_lorenz(welfare = params$data$welfare, weight = params$data$weight, - complete = TRUE) - # mean = mean, - # times_mean = times_mean, - # popshare = popshare, - # povline = povline) + complete = TRUE, + mean = mean, + times_mean = times_mean, + popshare = popshare, + povline = povline) } params From b525b23f6f902a39b71096a0dcf5f3137041b362 Mon Sep 17 00:00:00 2001 From: zander-prinsloo Date: Fri, 16 Feb 2024 15:59:32 -0500 Subject: [PATCH 28/29] pass all tests --- R/pipgd_dist.R | 15 ++------------- tests/testthat/test-get_dist.R | 6 +++--- tests/testthat/test-pipgd_dist.R | 11 +++++++---- 3 files changed, 12 insertions(+), 20 deletions(-) diff --git a/R/pipgd_dist.R b/R/pipgd_dist.R index 53015db..beb8226 100644 --- a/R/pipgd_dist.R +++ b/R/pipgd_dist.R @@ -82,7 +82,6 @@ pipgd_welfare_share_at <- function( welfare = welfare, weight = weight, params = params, - popshare = popshare, ... ) @@ -190,7 +189,6 @@ pipgd_quantile_welfare_share <- welfare = welfare, weight = weight, params = params, - popshare = popshare, ...) if (is.null(lorenz)) { @@ -304,9 +302,8 @@ pipgd_quantile <- welfare = welfare, weight = weight, params = params, - times_mean = times_mean, - popshare = popshare, ...) + mean <- params$data$mean if (is.null(lorenz)) { lorenz <- params$selected_lorenz$for_dist @@ -659,7 +656,7 @@ pipgd_polarization <- function( params <- vector("list") } - params$dist_stats$gini <- gini + params$dist_stats$gini <- gini params$dist_stats$polarization <- polarization params$dist_stats$lorenz <- lorenz @@ -713,11 +710,3 @@ validate_params <- function( - - - - - - - - diff --git a/tests/testthat/test-get_dist.R b/tests/testthat/test-get_dist.R index 838ff6b..dbebe8a 100644 --- a/tests/testthat/test-get_dist.R +++ b/tests/testthat/test-get_dist.R @@ -235,10 +235,10 @@ test_that("get_mld works", { out1_gd <- get_mld(pipster_object = gd_object) out1_md <- get_mld(pipster_object = md_object) out2_gd <- pipgd_mld(welfare = welfare_gd, - weight = weight_gd) + weight = weight_gd) out2_md <- pipmd_mld(welfare = welfare_md, - weight = weight_md, - format = "list") + weight = weight_md, + format = "list") expect_equal(out1_gd$mld , out2_gd$dist_stats$mld) diff --git a/tests/testthat/test-pipgd_dist.R b/tests/testthat/test-pipgd_dist.R index 584e044..5da4c0d 100644 --- a/tests/testthat/test-pipgd_dist.R +++ b/tests/testthat/test-pipgd_dist.R @@ -994,7 +994,8 @@ test_that("pipgd_polarization outputs work as expected", { expect_equal("dist_stats") names(res$dist_stats) |> - expect_equal(c("polarization", + expect_equal(c("gini", + "polarization", "lorenz")) # Names in output list when complete = TRUE @@ -1043,7 +1044,8 @@ test_that("pipgd_polarization outputs work as expected", { names(res_complete$data) |> expect_equal(c("welfare", - "weight")) + "weight", + "mean")) names(res_complete$selected_lorenz) |> expect_equal(c( "for_dist", @@ -1052,8 +1054,9 @@ test_that("pipgd_polarization outputs work as expected", { "use_lq_for_pov" )) names(res_complete$dist_stats) |> - expect_equal(c("polarization", - "lorenz")) + expect_equal(c("gini", + "lorenz", + "polarization")) }) From 6a36ddf49ee7150d6c813db770dd0816d95373a8 Mon Sep 17 00:00:00 2001 From: zander-prinsloo Date: Fri, 16 Feb 2024 15:59:43 -0500 Subject: [PATCH 29/29] documentation --- man/pipgd_gini.Rd | 5 ++++- man/pipgd_mld.Rd | 5 ++++- man/pipgd_params.Rd | 2 +- man/pipgd_polarization.Rd | 3 +++ man/pipgd_quantile.Rd | 8 ++++---- man/pipgd_quantile_welfare_share.Rd | 5 ++++- man/pipgd_welfare_share_at.Rd | 5 ++++- man/validate_params.Rd | 13 ++++++++++++- 8 files changed, 36 insertions(+), 10 deletions(-) diff --git a/man/pipgd_gini.Rd b/man/pipgd_gini.Rd index 90d282e..39a3d8d 100644 --- a/man/pipgd_gini.Rd +++ b/man/pipgd_gini.Rd @@ -10,7 +10,8 @@ pipgd_gini( welfare = NULL, weight = NULL, complete = getOption("pipster.return_complete"), - lorenz = NULL + lorenz = NULL, + ... ) } \arguments{ @@ -27,6 +28,8 @@ previously used \code{get_gd} functions. Default is \code{FALSE}} \item{lorenz}{character or NULL. Lorenz curve selected. It could be "lq" for Lorenz Quadratic or "lb" for Lorenz Beta} + +\item{...}{additional arguments for \link{pipgd_select_lorenz}} } \value{ Returns a nested list containing distribution statistics: diff --git a/man/pipgd_mld.Rd b/man/pipgd_mld.Rd index 7842654..1b12cc4 100644 --- a/man/pipgd_mld.Rd +++ b/man/pipgd_mld.Rd @@ -10,7 +10,8 @@ pipgd_mld( welfare = NULL, weight = NULL, complete = getOption("pipster.return_complete"), - lorenz = NULL + lorenz = NULL, + ... ) } \arguments{ @@ -27,6 +28,8 @@ previously used \code{get_gd} functions. Default is \code{FALSE}} \item{lorenz}{character or NULL. Lorenz curve selected. It could be "lq" for Lorenz Quadratic or "lb" for Lorenz Beta} + +\item{...}{additional arguments for \link{pipgd_select_lorenz}} } \value{ Returns a nested list containing distribution statistics: diff --git a/man/pipgd_params.Rd b/man/pipgd_params.Rd index 0674d8e..e9bc217 100644 --- a/man/pipgd_params.Rd +++ b/man/pipgd_params.Rd @@ -4,7 +4,7 @@ \alias{pipgd_params} \title{Get Group Data Parameters} \usage{ -pipgd_params(welfare, weight, mean = NULL, population = NULL) +pipgd_params(welfare, weight, mean = 1, population = NULL) } \arguments{ \item{welfare}{numeric vector of cumulative share of welfare (income/consumption)} diff --git a/man/pipgd_polarization.Rd b/man/pipgd_polarization.Rd index 3b845a8..2fb2234 100644 --- a/man/pipgd_polarization.Rd +++ b/man/pipgd_polarization.Rd @@ -5,6 +5,7 @@ \title{Compute polarization index} \usage{ pipgd_polarization( + pipster_object = NULL, params = NULL, welfare = NULL, weight = NULL, @@ -15,6 +16,8 @@ pipgd_polarization( ) } \arguments{ +\item{pipster_object}{pipster object created using \link{create_pipster_object}} + \item{params}{list of parameters from \code{pipgd_validate_lorenz()}} \item{welfare}{numeric vector of cumulative share of welfare (income/consumption)} diff --git a/man/pipgd_quantile.Rd b/man/pipgd_quantile.Rd index 69f60de..7d8f2fa 100644 --- a/man/pipgd_quantile.Rd +++ b/man/pipgd_quantile.Rd @@ -11,9 +11,9 @@ pipgd_quantile( weight = NULL, n = 10, popshare = seq(from = 1/n, to = 1, by = 1/n), - mean = 1, complete = getOption("pipster.return_complete"), - lorenz = NULL + lorenz = NULL, + ... ) } \arguments{ @@ -29,13 +29,13 @@ pipgd_quantile( \item{popshare}{numeric: vector of share of population. Default is \code{seq(from = 1/n, to = 1, by = 1/n)}} -\item{mean}{numeric scalar of distribution mean. Default is 1} - \item{complete}{logical: If TRUE, returns a list a cumulative returns from previously used \code{get_gd} functions. Default is \code{FALSE}} \item{lorenz}{character or NULL. Lorenz curve selected. It could be "lq" for Lorenz Quadratic or "lb" for Lorenz Beta} + +\item{...}{additional arguments for \link{pipgd_select_lorenz}} } \value{ Returns a nested list containing distribution statistics: diff --git a/man/pipgd_quantile_welfare_share.Rd b/man/pipgd_quantile_welfare_share.Rd index 228279f..96036d3 100644 --- a/man/pipgd_quantile_welfare_share.Rd +++ b/man/pipgd_quantile_welfare_share.Rd @@ -12,7 +12,8 @@ pipgd_quantile_welfare_share( complete = getOption("pipster.return_complete"), lorenz = NULL, n = 10, - popshare = seq(from = 1/n, to = 1, by = 1/n) + popshare = seq(from = 1/n, to = 1, by = 1/n), + ... ) } \arguments{ @@ -33,6 +34,8 @@ Lorenz Quadratic or "lb" for Lorenz Beta} \item{n}{numeric scalar for the number of quantiles to be used in \code{popshare}} \item{popshare}{numeric: vector of share of population. Default is \code{seq(from = 1/n, to = 1, by = 1/n)}} + +\item{...}{additional arguments for \link{pipgd_select_lorenz}} } \value{ Returns a nested list containing distribution statistics: diff --git a/man/pipgd_welfare_share_at.Rd b/man/pipgd_welfare_share_at.Rd index 97db62f..7f6264f 100644 --- a/man/pipgd_welfare_share_at.Rd +++ b/man/pipgd_welfare_share_at.Rd @@ -12,7 +12,8 @@ pipgd_welfare_share_at( complete = getOption("pipster.return_complete"), lorenz = NULL, n = 10, - popshare = seq(from = 1/n, to = 1, by = 1/n) + popshare = seq(from = 1/n, to = 1, by = 1/n), + ... ) } \arguments{ @@ -33,6 +34,8 @@ Lorenz Quadratic or "lb" for Lorenz Beta} \item{n}{numeric scalar for the number of quantiles to be used in \code{popshare}} \item{popshare}{numeric: vector of share of population. Default is \code{seq(from = 1/n, to = 1, by = 1/n)}} + +\item{...}{additional arguments for \link{pipgd_select_lorenz}} } \value{ Returns a nested list containing distribution statistics: diff --git a/man/validate_params.Rd b/man/validate_params.Rd index a1553b8..ab1e579 100644 --- a/man/validate_params.Rd +++ b/man/validate_params.Rd @@ -4,7 +4,16 @@ \alias{validate_params} \title{Validate group data parameters} \usage{ -validate_params(pipster_object, welfare, weight, params) +validate_params( + pipster_object, + welfare, + weight, + params, + mean = 1, + times_mean = 1, + popshare = NULL, + povline = ifelse(is.null(popshare), mean * times_mean, NA_real_) +) } \arguments{ \item{pipster_object}{pipster object created using \link{create_pipster_object}} @@ -14,6 +23,8 @@ validate_params(pipster_object, welfare, weight, params) \item{weight}{numeric vector of cumulative share of the population} \item{params}{list of parameters from \code{pipgd_validate_lorenz()}} + +\item{popshare}{numeric: vector of share of population. Default is \code{seq(from = 1/n, to = 1, by = 1/n)}} } \value{ list: \code{params} to be used in gd functions