Add option to control removal of implausible measures

NEWS.md

@@ -1,5 +1,13 @@
 # anthro (development version)
 
+## Method
+
+* `anthro_zscores` and `anthro_prevalence` have a new `control` parameter.
+   With this parameter you can control the certain behavior of the computation.
+   With this release `remove_implausible_measures` can be used to control if
+   implausible measures are set to `NA`. See the readme for more information.
+   The default behavior is to remove implausible measures. No breaking change.
+
 ## Performance
 
 * For inputs with `cluster/strata = NULL` and `sw = NULL or 1` a faster

R/prevalence.R

@@ -184,7 +184,10 @@ anthro_prevalence <- function(sex,
                               gregion = NA_character_,
                               wealthq = NA_character_,
                               mothered = NA_character_,
-                              othergr = NA_character_) {
+                              othergr = NA_character_,
+                              control = list(
+                                remove_implausible_measures = TRUE
+                              )) {
   # the other variables are being checked by anthro_zscores
   assert_character_or_numeric(typeres)
   assert_character_or_numeric(gregion)
@@ -227,7 +230,8 @@ anthro_prevalence <- function(sex,
     weight = input[["weight"]],
     lenhei = input[["lenhei"]],
     measure = input[["measure"]],
-    oedema = input[["oedema"]]
+    oedema = input[["oedema"]],
+    control = control
   )
   zscores_orig <- zscores
   stopifnot(c("zlen", "zwei", "zwfl", "zbmi") %in% colnames(zscores))

R/z-score.R

@@ -83,6 +83,11 @@
 #'             BUT they are treated as being < -3 SD in the weight-related
 #'             indicator prevalence (\code{\link{anthro_prevalence}})
 #'             estimation.
+#' @param control An optional list to control the behavior of the computation.
+#' Setting `remove_implausible_measures` to `TRUE` sets implausible measures to
+#' `NA`. A measure is considered implausible if its value is `"h"` and
+#' `age_in_months < 9`. If `remove_implausible_measures` is not `TRUE` or missing,
+#' the adjustment is not applied.
 #'
 #'
 #' @return A data.frame with three types of columns. Columns starting with a
@@ -167,7 +172,10 @@ anthro_zscores <- function(sex,
                            armc = NA_real_,
                            triskin = NA_real_,
                            subskin = NA_real_,
-                           oedema = "n") {
+                           oedema = "n",
+                           control = list(
+                             remove_implausible_measures = TRUE
+                           )) {
   assert_logical(is_age_in_month)
   assert_length(is_age_in_month, 1L)
   assert_character_or_numeric(sex)
@@ -190,6 +198,12 @@ anthro_zscores <- function(sex,
     allowed = c("n", "y", "N", "Y", "2", "1", NA_character_)
   )
 
+  # extract control options
+  if (!is.list(control)) {
+    control <- list()
+  }
+  remove_implausible_measures <- isTRUE(control[["remove_implausible_measures"]])
+
   # make all input lengths equal
   max_len <- pmax(
     length(sex),
@@ -227,13 +241,15 @@ anthro_zscores <- function(sex,
   age_in_days <- age_to_days(age, is_age_in_month = is_age_in_month)
   age_in_months <- age_to_months(age, is_age_in_month = is_age_in_month)
 
-  # we consider a height measure for children younger than 9 months as
-  # implausible
-  measure_implausible <- !is.na(cmeasure) &
-    !is.na(age_in_months) &
-    cmeasure == "h" &
-    age_in_months < 9
-  cmeasure[measure_implausible] <- NA_character_
+  if (remove_implausible_measures) {
+    # we consider a height measure for children younger than 9 months as
+    # implausible
+    measure_implausible <- !is.na(cmeasure) &
+      !is.na(age_in_months) &
+      cmeasure == "h" &
+      age_in_months < 9
+    cmeasure[measure_implausible] <- NA_character_
+  }
 
   clenhei <- adjust_lenhei(age_in_days, cmeasure, lenhei)
 

anthro.Rproj

@@ -1,4 +1,5 @@
 Version: 1.0
+ProjectId: f48ead27-57f4-40f2-998a-e1596291137c
 
 RestoreWorkspace: No
 SaveWorkspace: No

tests/testthat/test-zscores.R

@@ -241,3 +241,27 @@ test_that("clenhei takes the measure argument into account correctly", {
   expect_equal(res$clenhei, c(77.5, 77.5))
   expect_equal(res$zlen, c(-2.55, -2.55))
 })
+
+test_that("removal of implausible cmeasures can be controlled", {
+  res_default <- anthro_zscores(
+    sex = 2,
+    age = c(8, 9),
+    lenhei = 77.5,
+    weight = 8.8,
+    is_age_in_month = TRUE,
+    measure = c("h", "h")
+  )
+  res_no_adjustment <- anthro_zscores(
+    sex = 2,
+    age = c(8, 9),
+    lenhei = 77.5,
+    weight = 8.8,
+    is_age_in_month = TRUE,
+    measure = c("h", "h"),
+    control = list(
+      remove_implausible_measures = FALSE
+    )
+  )
+  expect_equal(res_default$cmeasure, c(NA_character_, "h"))
+  expect_equal(res_no_adjustment$cmeasure, c("h", "h"))
+})