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/NAMESPACE b/NAMESPACE index 269937c..2eb56d6 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,11 +1,89 @@ # 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_pip) +export(as_pipster_gd) +export(as_pipster_md) +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) export(pipgd_params) +export(pipgd_polarization) export(pipgd_pov_gap) export(pipgd_pov_headcount) export(pipgd_pov_severity) @@ -25,4 +103,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/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/create_pipster_object.R b/R/create_pipster_object.R new file mode 100644 index 0000000..ddd8760 --- /dev/null +++ b/R/create_pipster_object.R @@ -0,0 +1,103 @@ +#' 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 argument 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" = { + cl <- "md" + }, + "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---------------------------------------------------------------------- + class_func <- paste0("new_pipster_", cl) |> + parse(text = _) + ret <- list( + welfare = eval(class_func)(welfare), + weight = eval(class_func)(weight) + ) + if (cl == "gd") { + ret$params <- params + } else { + ret$imputation_id <- imputation_id + } + class(ret) <- "pipster" + + ret + +} + + + diff --git a/R/get_dist.R b/R/get_dist.R new file mode 100644 index 0000000..d168378 --- /dev/null +++ b/R/get_dist.R @@ -0,0 +1,668 @@ +# 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 +#' @param ... additional arguments passed to methods +#' +#' @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 +#' @param ... additional arguments passed to methods +#' +#' @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 +#' @param ... additional arguments passed to methods +#' +#' @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] +#' @param ... additional arguments passed to methods +#' +#' @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] +#' @param ... additional arguments passed to methods +#' +#' @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", + ...) + } + + +#' Wolfson polarization index 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] +#' @param ... additional arguments passed to methods +#' +#' @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 + + } + + +#' Mean Log Deviation (MLD) for micro data +#' +#' 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_mld] +#' +#' @return list +#' @export +get_mld.pipster_md <- + function(pipster_object, + ...) { + + pipmd_mld(pipster_object = pipster_object, + format = "list", + ...) + } + + +#' MLD 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.") + } + + + + + + + + + + + + + + + + + + + + + + + diff --git a/R/get_pov.R b/R/get_pov.R new file mode 100644 index 0000000..33a6002 --- /dev/null +++ b/R/get_pov.R @@ -0,0 +1,421 @@ + + +# 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 +#' @param ... additional arguments passed to methods +#' +#' @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 +#' @param ... additional arguments passed to methods +#' +#' @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 +#' @param ... additional arguments passed to methods +#' +#' @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 +#' @param ... additional arguments passed to methods +#' +#' @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_watts.default <- + function(pipster_object, + ...) { + + cli::cli_abort("No default exist. Please check object class.") + } + + 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 -------- diff --git a/R/pipgd_dist.R b/R/pipgd_dist.R index e182a30..beb8226 100644 --- a/R/pipgd_dist.R +++ b/R/pipgd_dist.R @@ -10,11 +10,13 @@ #' 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 #' = 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 @@ -58,13 +60,15 @@ #' 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 +78,12 @@ 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 @@ -124,6 +125,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 @@ -166,31 +168,28 @@ 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 #### 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 @@ -201,7 +200,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)) @@ -280,34 +280,30 @@ 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, popshare = seq(from = 1/n, to = 1, by = 1/n), - mean = 1, complete = getOption("pipster.return_complete"), - lorenz = NULL) { + lorenz = NULL, + ...) { # _________________________________________________________________ # Defenses #### 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, + ...) + mean <- params$data$mean if (is.null(lorenz)) { lorenz <- params$selected_lorenz$for_dist @@ -317,9 +313,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"]], @@ -343,6 +336,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. @@ -367,11 +361,13 @@ pipgd_quantile <- #' weight = pip_gd$P, #' complete = TRUE) pipgd_gini <- function( + pipster_object = NULL, params = NULL, welfare = NULL, weight = NULL, complete = getOption("pipster.return_complete"), - lorenz = NULL + lorenz = NULL, + ... ){ # _________________________________________________________________ @@ -383,13 +379,11 @@ 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 @@ -444,6 +438,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. @@ -469,11 +464,13 @@ pipgd_gini <- function( #' complete = TRUE) #' pipgd_mld <- function( - params = NULL, - welfare = NULL, - weight = NULL, - complete = getOption("pipster.return_complete"), - lorenz = NULL + pipster_object = NULL, + params = NULL, + welfare = NULL, + weight = NULL, + complete = getOption("pipster.return_complete"), + lorenz = NULL, + ... ){ # _________________________________________________________________ @@ -485,13 +482,11 @@ 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 @@ -529,17 +524,189 @@ 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( + pipster_object = NULL, + 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(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( + # welfare = welfare, + # weight = weight, + # complete = TRUE, + # lorenz = lorenz + # ) + # } + + # _________________________________________________________________ + # Select Lorenz + # _________________________________________________________________ + if (is.null(lorenz)) { + lorenz <- params$selected_lorenz$for_dist + } else { + match.arg(lorenz, c("lq", "lb")) + } + + + # Set arguments + p0 <- 0.5 # constant + mean <- params$data$mean + 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$gini <- gini + params$dist_stats$polarization <- polarization + params$dist_stats$lorenz <- lorenz + + params +} + + + +#' 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, + 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, + 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) + } + params +} 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()`" ) 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) { # ____________________________________________________________________________ diff --git a/R/pipgd_pov.R b/R/pipgd_pov.R index fba6112..b5fc713 100644 --- a/R/pipgd_pov.R +++ b/R/pipgd_pov.R @@ -13,39 +13,42 @@ #' @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(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 +119,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 +142,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,41 +172,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, - mean = mean, - 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)) { @@ -299,18 +308,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) @@ -320,15 +330,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 #### @@ -357,18 +368,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 = 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, + pov_gap = NULL, + complete = getOption("pipster.return_complete") ){ # __________________________________________________________________________ # Defenses --------------------------------------------------------------- @@ -379,8 +391,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 } @@ -388,24 +401,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 ------------------------------------------------------- @@ -530,19 +545,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") ) { # ____________________________________________________________________________ @@ -565,16 +581,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 ) # ____________________________________________________________________________ @@ -610,47 +627,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 = 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_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)) { @@ -659,7 +665,6 @@ pipgd_watts_nv <- function( match.arg(lorenz, c("lq", "lb")) } - # Ensure `povline` exists ----------- if (!is.null(popshare)) { derive_ <- @@ -671,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 ----------------------------------------------------- @@ -683,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 @@ -753,18 +758,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 = 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") ) { # ____________________________________________________________________________ @@ -779,15 +785,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 ) # ____________________________________________________________________________ diff --git a/R/pipmd_dist.R b/R/pipmd_dist.R index 5c912d5..25d3a2b 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( @@ -224,6 +244,9 @@ pipmd_quantile_welfare_share <- function( popshare = popshare, format = format ) + if (is.null(n)) { + output <- output[1] + } # ____________________________________________________________________________ # Return --------------------------------------------------------------------- @@ -268,14 +291,26 @@ 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() + } + + if (is.unsorted(welfare)) { + weight <- weight[order(welfare)] + welfare <- welfare[order(welfare)] + } + # defenses --------- check_pipmd_dist() @@ -343,17 +378,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 +439,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 +468,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( diff --git a/R/pipmd_pov.R b/R/pipmd_pov.R index 2092d83..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. @@ -17,14 +18,18 @@ #' @return numeric: Poverty headcount ratio #' @keywords internal pipmd_pov_headcount_nv <- function( - welfare , - weight = rep(1, length = length(welfare)), - povline = fmean(welfare, w = weight)*times_mean, - times_mean = 1 + 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 +81,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 +101,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 +144,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() # ____________________________________________________________________________ @@ -166,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" @@ -196,7 +209,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 +229,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 +270,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 +334,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 +354,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 +392,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 +455,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 +475,7 @@ pipmd_watts <- function( SIMPLIFY = FALSE ) list_watts <- pipmd_watts_v( + pipster_object = pipster_object, welfare = welfare, weight = weight, povline = povline 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 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/R/pipster_gd.R b/R/pipster_gd.R new file mode 100644 index 0000000..b1eb840 --- /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_pipster_gd <- 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, ...) + ) +} + + + + + + + + + + + + + + diff --git a/R/pipster_md.R b/R/pipster_md.R new file mode 100644 index 0000000..0b1467d --- /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 pipster micro 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_pipster_md <- 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, ...) { + as.numeric(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`.")) +} + + + + + + + + +# 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..4421acb --- /dev/null +++ b/man/get_gini.Rd @@ -0,0 +1,19 @@ +% 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}} + +\item{...}{additional arguments passed to methods} +} +\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..dba8341 --- /dev/null +++ b/man/get_mld.Rd @@ -0,0 +1,20 @@ +% 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}} + +\item{...}{additional arguments passed to methods} +} +\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..f673e3f --- /dev/null +++ b/man/get_polarization.Rd @@ -0,0 +1,19 @@ +% 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}} + +\item{...}{additional arguments passed to methods} +} +\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..6d97762 --- /dev/null +++ b/man/get_pov_gap.Rd @@ -0,0 +1,22 @@ +% 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.} + +\item{...}{additional arguments passed to methods} +} +\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..2e9f189 --- /dev/null +++ b/man/get_pov_headcount.Rd @@ -0,0 +1,22 @@ +% 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.} + +\item{...}{additional arguments passed to methods} +} +\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..471d071 --- /dev/null +++ b/man/get_pov_severity.Rd @@ -0,0 +1,22 @@ +% 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.} + +\item{...}{additional arguments passed to methods} +} +\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..b26f98f --- /dev/null +++ b/man/get_quantile.Rd @@ -0,0 +1,29 @@ +% 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)}} + +\item{...}{additional arguments passed to methods} +} +\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..6542a13 --- /dev/null +++ b/man/get_quantile_welfare_share.Rd @@ -0,0 +1,33 @@ +% 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)}} + +\item{...}{additional arguments passed to methods} +} +\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..79f0efc --- /dev/null +++ b/man/get_watts.Rd @@ -0,0 +1,22 @@ +% 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.} + +\item{...}{additional arguments passed to methods} +} +\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..4025ef3 --- /dev/null +++ b/man/get_welfare_share_at.Rd @@ -0,0 +1,31 @@ +% 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)}} + +\item{...}{additional arguments passed to methods} +} +\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..39a3d8d 100644 --- a/man/pipgd_gini.Rd +++ b/man/pipgd_gini.Rd @@ -5,14 +5,18 @@ \title{Compute Gini coefficient} \usage{ pipgd_gini( + pipster_object = NULL, params = NULL, welfare = NULL, weight = NULL, complete = getOption("pipster.return_complete"), - lorenz = NULL + lorenz = NULL, + ... ) } \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)} @@ -24,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 988546d..1b12cc4 100644 --- a/man/pipgd_mld.Rd +++ b/man/pipgd_mld.Rd @@ -5,14 +5,18 @@ \title{Compute MLD} \usage{ pipgd_mld( + pipster_object = NULL, params = NULL, welfare = NULL, weight = NULL, complete = getOption("pipster.return_complete"), - lorenz = NULL + lorenz = NULL, + ... ) } \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)} @@ -24,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 new file mode 100644 index 0000000..2fb2234 --- /dev/null +++ b/man/pipgd_polarization.Rd @@ -0,0 +1,69 @@ +% 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( + pipster_object = NULL, + params = NULL, + welfare = NULL, + weight = NULL, + mean = 1, + gini = NULL, + complete = getOption("pipster.return_complete"), + lorenz = NULL +) +} +\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)} + +\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/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..b17d222 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 = NULL, 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..7d8f2fa 100644 --- a/man/pipgd_quantile.Rd +++ b/man/pipgd_quantile.Rd @@ -5,17 +5,20 @@ \title{Get quantile at specified shared of population - grouped data} \usage{ pipgd_quantile( + pipster_object = NULL, params = NULL, welfare = NULL, 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{ +\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)} @@ -26,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 36c8783..96036d3 100644 --- a/man/pipgd_quantile_welfare_share.Rd +++ b/man/pipgd_quantile_welfare_share.Rd @@ -5,16 +5,20 @@ \title{Quantile welfare share} \usage{ pipgd_quantile_welfare_share( + 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) + popshare = seq(from = 1/n, to = 1, by = 1/n), + ... ) } \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)} @@ -30,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_watts.Rd b/man/pipgd_watts.Rd index f338e28..e0c509a 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 = NULL, 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..15b03af 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 = NULL, 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..7f6264f 100644 --- a/man/pipgd_welfare_share_at.Rd +++ b/man/pipgd_welfare_share_at.Rd @@ -5,16 +5,20 @@ \title{Welfare share by quantile in group data} \usage{ pipgd_welfare_share_at( + 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) + popshare = seq(from = 1/n, to = 1, by = 1/n), + ... ) } \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)} @@ -30,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/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..b830a5e 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, @@ -13,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 53df773..2a38656 100644 --- a/man/pipmd_pov_gap_nv.Rd +++ b/man/pipmd_pov_gap_nv.Rd @@ -5,13 +5,16 @@ \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 ) } \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 8d9a627..cd0ed1a 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, @@ -13,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 de55df1..b425158 100644 --- a/man/pipmd_pov_headcount_nv.Rd +++ b/man/pipmd_pov_headcount_nv.Rd @@ -5,13 +5,16 @@ \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 ) } \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 bcb74c4..9d27892 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, @@ -13,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 0306b6b..1326a6b 100644 --- a/man/pipmd_pov_severity_nv.Rd +++ b/man/pipmd_pov_severity_nv.Rd @@ -5,13 +5,16 @@ \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 ) } \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_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..239d21a 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, @@ -13,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 033b513..8a03722 100644 --- a/man/pipmd_watts_nv.Rd +++ b/man/pipmd_watts_nv.Rd @@ -5,13 +5,16 @@ \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 ) } \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_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..868d7fa --- /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_pipster_gd} +\title{\code{pipster_gd} vector} +\usage{ +pipster_gd(x = double()) + +is_pipster_gd(x) + +as_pipster_gd(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..f307ea0 --- /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_pipster_md} +\title{\code{pipster_md} vector} +\usage{ +pipster_md(x = double()) + +is_pipster_md(x) + +as_pipster_md(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 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 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} 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..dbebe8a --- /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_dist.R b/tests/testthat/test-pipgd_dist.R index 88b3e68..5da4c0d 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", @@ -887,4 +934,168 @@ 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("gini", + "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", + "mean")) + + 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("gini", + "lorenz", + "polarization")) + +}) + +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) + +}) + + + 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-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)) }) 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") +}) + +