Skip to content
This repository has been archived by the owner on May 3, 2024. It is now read-only.

change ipc_muac_check output; fix #2;#3;#4;#6;#7;#8 #12

Merged
merged 3 commits into from
Feb 19, 2024
Merged
Show file tree
Hide file tree
Changes from 1 commit
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
Next Next commit
change ipc_muac_check output; fix #2;#3;#4;#6;#7;#8
  • Loading branch information
ernestguevarra committed Feb 19, 2024
commit b356a0db21620824eeaac0d855e6e2b5555b0403
3 changes: 2 additions & 1 deletion NAMESPACE
Original file line number Diff line number Diff line change
@@ -1,14 +1,15 @@
# Generated by roxygen2: do not edit by hand

export(calculate_prevalence)
export(calculate_unweighted_prevalence)
export(calculate_weighted_prevalence)
export(classify_acute_malnutrition)
export(classify_age_ratio)
export(classify_quality)
export(classify_sd)
export(classify_sex_ratio)
export(ipc_calculate_prevalence)
export(ipc_muac_check)
export(summarise_muac_check)
importFrom(dplyr,case_when)
importFrom(dplyr,group_by)
importFrom(dplyr,mutate)
Expand Down
104 changes: 87 additions & 17 deletions R/muac_checks.R
Original file line number Diff line number Diff line change
Expand Up @@ -38,6 +38,9 @@
#' Setting `.summary` to FALSE is usually only used for when the output
#' structure is required for further analysis (i.e., calculation of
#' prevalence).
#' @param .list Logical. Relevent only if `.summary` is TRUE. Should summary be
#' given in list format? If TRUE (default), then the output is in list format
#' otherwise a data.frame is provided.
#'
#' @return A data.frame with a single row with each column for each metric used
#' to check MUAC dataset if `.summary` is TRUE. If `.summary` is FALSE, a
Expand All @@ -59,7 +62,8 @@ ipc_muac_check <- function(df,
muac_units = c("mm", "cm"),
oedema = "oedema",
oedema_recode = NULL,
.summary = TRUE) {
.summary = TRUE,
.list = TRUE) {
## Determine MUAC units ----
muac_units <- match.arg(muac_units)

Expand All @@ -86,16 +90,53 @@ ipc_muac_check <- function(df,
df <- df |> dplyr::mutate(muac = muac * 10)
}

# if (.summary) {
summarise_muac_check(df, .summary = .summary, .list = .list)
# } else {
# df |>
# dplyr::mutate(
# age_ratio = nipnTK::ageRatioTest(as.integer(!is.na(age)))$observedR,
# age_ratio_p = nipnTK::ageRatioTest(as.integer(!is.na(age)))$p,
# sex_ratio = nipnTK::sexRatioTest(sex, codes = c(1, 2))$pM,
# sex_ratio_p = nipnTK::sexRatioTest(sex, codes = c(1, 2))$p,
# digit_preference = nipnTK::digitPreference(muac, digits = 0)$dps,
# digit_preference_class = nipnTK::digitPreference(muac, digits = 0)$dpsClass,
# std_dev = stats::sd(muac, na.rm = TRUE),
# age_ratio_class = classify_age_ratio(.data$age_ratio_p),
# sex_ratio_class = classify_sex_ratio(.data$sex_ratio_p),
# std_dev_class = classify_sd(.data$std_dev),
# quality_score = classify_quality(
# .data$age_ratio_class, .data$sex_ratio_class,
# .data$std_dev_class, .data$digit_preference_class
# )$q_score,
# quality_class = classify_quality(
# .data$age_ratio_class, .data$sex_ratio_class,
# .data$std_dev_class, .data$digit_preference_class
# )$q_class
# ) |>
# dplyr::relocate(.data$age_ratio_class, .after = "age_ratio_p") |>
# dplyr::relocate(.data$sex_ratio_class, .after = "sex_ratio_p") |>
# dplyr::relocate(.data$std_dev_class, .after = "std_dev")
# }
}


#'
#' @rdname ipc_muac_check
#' @export
#'

summarise_muac_check <- function(df, .summary = TRUE, .list = TRUE) {
if (.summary) {
df |>
muac_check <- df |>
dplyr::summarise(
age_ratio = nipnTK::ageRatioTest(as.integer(!is.na(age)))$observedR,
age_ratio_p = nipnTK::ageRatioTest(as.integer(!is.na(age)))$p,
sex_ratio = nipnTK::sexRatioTest(sex, codes = c(1, 2))$pM,
sex_ratio_p = nipnTK::sexRatioTest(sex, codes = c(1, 2))$p,
digit_preference = nipnTK::digitPreference(muac, digits = 0)$dps,
digit_preference_class = nipnTK::digitPreference(muac, digits = 0)$dpsClass,
std_dev = stats::sd(muac, na.rm = TRUE),
age_ratio = nipnTK::ageRatioTest(as.integer(!is.na(.data$age)))$observedR,
age_ratio_p = nipnTK::ageRatioTest(as.integer(!is.na(.data$age)))$p,
sex_ratio = nipnTK::sexRatioTest(.data$sex, codes = c(1, 2))$pM,
sex_ratio_p = nipnTK::sexRatioTest(.data$sex, codes = c(1, 2))$p,
digit_preference = nipnTK::digitPreference(.data$muac, digits = 0)$dps,
digit_preference_class = nipnTK::digitPreference(.data$muac, digits = 0)$dpsClass,
std_dev = stats::sd(.data$muac, na.rm = TRUE),
age_ratio_class = classify_age_ratio(.data$age_ratio_p),
sex_ratio_class = classify_sex_ratio(.data$sex_ratio_p),
std_dev_class = classify_sd(.data$std_dev),
Expand All @@ -111,16 +152,41 @@ ipc_muac_check <- function(df,
dplyr::relocate(.data$age_ratio_class, .after = "age_ratio_p") |>
dplyr::relocate(.data$sex_ratio_class, .after = "sex_ratio_p") |>
dplyr::relocate(.data$std_dev_class, .after = "std_dev")

if (.list) {
muac_check <- list(
`Age Ratio` = list(
ratio = muac_check$age_ratio,
p = muac_check$age_ratio_p,
class = muac_check$age_ratio_class
),
`Sex Ratio` = list(
ratio = muac_check$sex_ratio,
p = muac_check$sex_ratio_p,
class = muac_check$sex_ratio_class
),
`Digit Preference` = list(
score = muac_check$digit_preference,
class = muac_check$digit_preference_class
),
`Standard Deviation` = list(
std_dev = muac_check$std_dev,
class = muac_check$std_dev_class
)
)
} else {
muac_check
}
} else {
df |>
muac_check <- df |>
dplyr::mutate(
age_ratio = nipnTK::ageRatioTest(as.integer(!is.na(age)))$observedR,
age_ratio_p = nipnTK::ageRatioTest(as.integer(!is.na(age)))$p,
sex_ratio = nipnTK::sexRatioTest(sex, codes = c(1, 2))$pM,
sex_ratio_p = nipnTK::sexRatioTest(sex, codes = c(1, 2))$p,
digit_preference = nipnTK::digitPreference(muac, digits = 0)$dps,
digit_preference_class = nipnTK::digitPreference(muac, digits = 0)$dpsClass,
std_dev = stats::sd(muac, na.rm = TRUE),
age_ratio = nipnTK::ageRatioTest(as.integer(!is.na(.data$age)))$observedR,
age_ratio_p = nipnTK::ageRatioTest(as.integer(!is.na(.data$age)))$p,
sex_ratio = nipnTK::sexRatioTest(.data$sex, codes = c(1, 2))$pM,
sex_ratio_p = nipnTK::sexRatioTest(.data$sex, codes = c(1, 2))$p,
digit_preference = nipnTK::digitPreference(.data$muac, digits = 0)$dps,
digit_preference_class = nipnTK::digitPreference(.data$muac, digits = 0)$dpsClass,
std_dev = stats::sd(.data$muac, na.rm = TRUE),
age_ratio_class = classify_age_ratio(.data$age_ratio_p),
sex_ratio_class = classify_sex_ratio(.data$sex_ratio_p),
std_dev_class = classify_sd(.data$std_dev),
Expand All @@ -137,4 +203,8 @@ ipc_muac_check <- function(df,
dplyr::relocate(.data$sex_ratio_class, .after = "sex_ratio_p") |>
dplyr::relocate(.data$std_dev_class, .after = "std_dev")
}

## Return muac_check ----
muac_check
}

40 changes: 14 additions & 26 deletions R/muac_prevalence.R
Original file line number Diff line number Diff line change
@@ -1,6 +1,9 @@
#'
#' Calculate wasting prevalence by MUAC
#'
#' @param df A data.frame for a MUAC dataset on which appropriate checks have
#' been applied already produced via a call to `ipc_muac_check()` with the
#' `.summary` argument set to FALSE.
#' @param age A numeric or integer value or vector of values for age of child.
#' The age of child should be in months.
#' @param sex A value or a vector of values for sex of child. The expected
Expand All @@ -27,9 +30,6 @@
#' value for presence of oedema and "n" is the value for no oedema, then
#' specify `c("y", "n)`. If set to NULL (default), then the values c(1, 0)
#' are used.
#' @param quality_class A vector or character values indicating the
#' classification of the quality of the MUAC dataset. This is usually
#' created from applying the `ipc_muac_check()` function.
#' @param status Which wasting anthropometric indicator to report. A choice
#' between c("sam", "mam"). Default to "sam"
#'
Expand All @@ -42,19 +42,14 @@
#' status = "sam"
#' )
#'
#' df <- ipc_muac_check(
#' ipc_muac_check(
#' muac_data, age = "age", sex = "sex",
#' muac = "muac", muac_units = "cm",
#' oedema = "oedema", oedema_recode = c(1, 2),
#' .summary = FALSE
#' )
#' ) |>
#' ipc_calculate_prevalence()
#'
#' with(df,
#' calculate_prevalence(
#' age = age, sex = sex, muac = muac,
#' oedema = oedema, quality_class = quality_class
#' )
#' )
#'
#' @rdname ipc_prevalence
#' @export
Expand Down Expand Up @@ -144,29 +139,22 @@ calculate_weighted_prevalence <- function(age,
#'

## Function to calculate prevalence (weighted or unweighted as appropriate) ----
calculate_prevalence <- function(age,
sex,
sex_recode = NULL,
muac,
muac_units = c("mm", "cm"),
oedema,
oedema_recode = NULL,
quality_class,
status = c("sam", "mam")) {
ipc_calculate_prevalence <- function(df,
status = c("sam", "mam")) {
## Get nut status to work on ----
status <- match.arg(status)

## Calculate prevalence data.frame ----
prevalence <- data.frame(age, sex, muac, oedema, quality_class) |>
prevalence <- df |>
dplyr::summarise(
quality_class = unique(quality_class),
quality_class = unique(.data$quality_class),
unweighted_prevalence = calculate_unweighted_prevalence(
muac = muac, oedema = oedema, status = status
muac = .data$muac, oedema = .data$oedema, status = status
),
weighted_prevalence = calculate_weighted_prevalence(
age = age, sex = sex, sex_recode = sex_recode,
muac = muac, muac_units = muac_units,
oedema = oedema, oedema_recode = oedema_recode, status = status
age = .data$age, sex = .data$sex,
muac = .data$muac, oedema = .data$oedema,
status = status
),
.groups = "drop"
) |>
Expand Down
12 changes: 12 additions & 0 deletions README.Rmd
Original file line number Diff line number Diff line change
Expand Up @@ -68,6 +68,18 @@ These checks can be performed using the `ipc_muac_check()` function as follows:
ipc_muac_check(df = muac_data, muac_units = "cm", oedema_recode = c(1, 2))
```

### Calculating acute malnutrition prevalence on a MUAC dataset

The IPC-recommended approach to calculating prevalence of acute malnutrition based on MUAC is to perform a weighted analysis when either the age ratio test or the sex ratio test is problematic. For example, based on the MUAC check shown above, the example dataset `muac_data` has some issues with its age ratio and sex ratio. To calculate acute malnutrition prevalence from this dataset, a weighted analysis will have to be implemented. This can be done using the `ipc_calculate_prevalence()` function as follows:

```{r ipc-prevalence}
ipc_muac_check(
df = muac_data, muac_units = "cm",
oedema_recode = c(1, 2),
.summary = FALSE
) |>
ipc_calculate_prevalence()
```

## Citation

Expand Down
69 changes: 62 additions & 7 deletions README.md
Original file line number Diff line number Diff line change
Expand Up @@ -93,13 +93,68 @@ follows:

``` r
ipc_muac_check(df = muac_data, muac_units = "cm", oedema_recode = c(1, 2))
#> # A tibble: 1 × 12
#> age_ratio age_ratio_p age_ratio_class sex_ratio sex_ratio_p sex_ratio_class
#> <dbl> <dbl> <fct> <dbl> <dbl> <fct>
#> 1 Inf 7.79e-113 Problematic 0.506 0.848 Excellent
#> # ℹ 6 more variables: digit_preference <dbl>, digit_preference_class <chr>,
#> # std_dev <dbl>, std_dev_class <fct>, quality_score <dbl>,
#> # quality_class <chr>
#> $`Age Ratio`
#> $`Age Ratio`$ratio
#> [1] Inf
#>
#> $`Age Ratio`$p
#> [1] 7.785732e-113
#>
#> $`Age Ratio`$class
#> [1] Problematic
#> Levels: Problematic Poor Acceptable Excellent
#>
#>
#> $`Sex Ratio`
#> $`Sex Ratio`$ratio
#> p
#> 0.5057471
#>
#> $`Sex Ratio`$p
#> [1] 0.8479104
#>
#> $`Sex Ratio`$class
#> [1] Excellent
#> Levels: Problematic Poor Acceptable Excellent
#>
#>
#> $`Digit Preference`
#> $`Digit Preference`$score
#> [1] 16.35
#>
#> $`Digit Preference`$class
#> SMART DPS Class
#> "Acceptable"
#>
#>
#> $`Standard Deviation`
#> $`Standard Deviation`$std_dev
#> [1] 12.45931
#>
#> $`Standard Deviation`$class
#> [1] Excellent
#> Levels: Excellent Acceptable Poor Problematic
```

### Calculating acute malnutrition prevalence on a MUAC dataset

The IPC-recommended approach to calculating prevalence of acute
malnutrition based on MUAC is to perform a weighted analysis when either
the age ratio test or the sex ratio test is problematic. For example,
based on the MUAC check shown above, the example dataset `muac_data` has
some issues with its age ratio and sex ratio. To calculate acute
malnutrition prevalence from this dataset, a weighted analysis will have
to be implemented. This can be done using the
`ipc_calculate_prevalence()` function as follows:

``` r
ipc_muac_check(
df = muac_data, muac_units = "cm",
oedema_recode = c(1, 2),
.summary = FALSE
) |>
ipc_calculate_prevalence()
#> [1] 0.2179668
```

## Citation
Expand Down
8 changes: 4 additions & 4 deletions man/ipc_class.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

Loading