[feature]-add-precision-flag-for-z

DESCRIPTION

@@ -23,7 +23,7 @@ Imports:
     survey
 Suggests:
     testthat
-RoxygenNote: 7.3.2
+RoxygenNote: 7.3.3
 Collate:
     'anthro-package.R'
     'utils.R'

R/api.R

@@ -4,6 +4,7 @@
 #' @param m a numeric vector
 #' @param l a numeric vector
 #' @param s a numeric vector
+#' @param z_precision number of digits to round the zscore to. If NULL, 2 digits are used.
 #'
 #' @note
 #' This function is meant to be used by other anthro related packages.
@@ -23,6 +24,7 @@ anthro_api_compute_zscore <- compute_zscore
 #' @param m a numeric vector
 #' @param l a numeric vector
 #' @param s a numeric vector
+#' @param z_precision number of digits to round the zscore to. If NULL, 2 digits are used.
 #'
 #' @note
 #' This function is meant to be used by other anthro related packages.
@@ -52,6 +54,7 @@ anthro_api_compute_zscore_adjusted <- compute_zscore_adjusted
 #'   -3.1 if \code{oedema = "y"} for prevalence estimates.}
 #'   \item{auxiliary_zscore_condition}{optional function to define a special
 #'   condition when the z-score should be set to -3.1}
+#'   \item{z_precision}{number of digits to round the zscore to. If NULL, 2 digits are used.}
 #' }
 #' @param survey_subsets subsets for which the prevalence values should be
 #' computed. It is a named list of characters, where the values correspond

R/z-score-arm-circumference-for-age.R

@@ -17,7 +17,8 @@ anthro_zscore_arm_circumference_for_age <-
     age_in_months,
     sex,
     flag_threshold = 5,
-    growthstandards = growthstandards_acanthro
+    growthstandards = growthstandards_acanthro,
+    z_precision = 2L
   ) {
     anthro_zscore_adjusted(
       name = "ac",
@@ -27,6 +28,7 @@ anthro_zscore_arm_circumference_for_age <-
       sex = sex,
       growthstandards = growthstandards,
       flag_threshold = flag_threshold,
-      allowed_age_range = c(91, 1856)
+      allowed_age_range = c(91, 1856),
+      z_precision = z_precision
     )
   }

R/z-score-bmi-for-age.R

@@ -18,7 +18,8 @@ anthro_zscore_bmi_for_age <-
     sex,
     oedema,
     flag_threshold = 5,
-    growthstandards = growthstandards_bmianthro
+    growthstandards = growthstandards_bmianthro,
+    z_precision = 2L
   ) {
     anthro_zscore_adjusted(
       name = "bmi",
@@ -29,6 +30,7 @@ anthro_zscore_bmi_for_age <-
       growthstandards = growthstandards,
       flag_threshold = flag_threshold,
       allowed_age_range = c(0, 1856),
-      !(oedema %in% "y")
+      !(oedema %in% "y"),
+      z_precision = z_precision
     )
   }

R/z-score-head-circumference-for-age.R

@@ -17,7 +17,8 @@ anthro_zscore_head_circumference_for_age <-
     age_in_months,
     sex,
     flag_threshold = 5,
-    growthstandards = growthstandards_hcanthro
+    growthstandards = growthstandards_hcanthro,
+    z_precision = 2L
   ) {
     anthro_zscore_adjusted(
       name = "hc",
@@ -28,6 +29,7 @@ anthro_zscore_head_circumference_for_age <-
       growthstandards = growthstandards,
       flag_threshold = flag_threshold,
       allowed_age_range = c(0, 1856),
-      zscore_fun = compute_zscore
+      zscore_fun = compute_zscore,
+      z_precision = z_precision
     )
   }

R/z-score-helper.R

@@ -9,7 +9,7 @@
 #' http://www.who.int/childgrowth/standards/Chap_7.pdf
 #'
 #' @noRd
-compute_zscore <- function(y, m, l, s) {
+compute_zscore <- function(y, m, l, s, ...) {
   stopifnot(is.numeric(y), is.numeric(m), is.numeric(l), is.numeric(s))
   ((y / m)^l - 1) / (s * l)
 }
@@ -25,8 +25,11 @@ compute_zscore <- function(y, m, l, s) {
 #' http://www.who.int/childgrowth/standards/Chap_7.pdf
 #'
 #' @noRd
-compute_zscore_adjusted <- function(y, m, l, s) {
+compute_zscore_adjusted <- function(y, m, l, s, z_precision = 2L) {
   stopifnot(is.numeric(y), is.numeric(m), is.numeric(l), is.numeric(s))
+  stopifnot(is.numeric(z_precision), length(z_precision) == 1L)
+  if (z_precision < 0) stop("z_precision must be >= 0", call. = FALSE)
+  z_precision <- as.integer(z_precision)
   calc_sd <- function(sd) m * ((1 + l * s * sd)^(1 / l))
 
   zscore <- compute_zscore(y, m, l, s)
@@ -42,6 +45,7 @@ compute_zscore_adjusted <- function(y, m, l, s) {
   zscore_lt_3 <- not_zscore_na & zscore < -3
   zscore[zscore_lt_3] <- (-3 + ((y - SD3neg) / SD23neg))[zscore_lt_3]
 
+  zscore <- round(zscore, digits = z_precision)
   zscore
 }
 
@@ -50,7 +54,8 @@ apply_zscore_and_growthstandards <- function(
   growthstandards,
   age_in_days,
   sex,
-  measure
+  measure,
+  z_precision = 2L
 ) {
   n <- length(measure)
   age_in_days[!is.na(age_in_days) & age_in_days < 0] <- NA_real_
@@ -70,8 +75,8 @@ apply_zscore_and_growthstandards <- function(
   m <- merged_df[["m"]]
   l <- merged_df[["l"]]
   s <- merged_df[["s"]]
-  zscore <- zscore_fun(y, m, l, s)
-  round(zscore, digits = 2L)
+  zscore <- zscore_fun(y, m, l, s, z_precision = z_precision)
+  round(zscore, digits = z_precision)
 }
 
 flag_zscore <- function(flag_threshold, score_name, zscore, valid_zscore) {
@@ -135,7 +140,8 @@ anthro_zscore_adjusted <-
     flag_threshold,
     allowed_age_range = c(0, 1856),
     zscore_is_valid = rep.int(TRUE, length(measure)),
-    zscore_fun = compute_zscore_adjusted
+    zscore_fun = compute_zscore_adjusted,
+    z_precision = 2L
   ) {
     stopifnot(is.character(name), length(name) == 1L, !is.na(name))
     stopifnot(is.numeric(measure))
@@ -165,7 +171,8 @@ anthro_zscore_adjusted <-
       growthstandards,
       age_in_days,
       sex,
-      measure
+      measure,
+      z_precision = z_precision
     )
 
     # we only compute zscores for children age < 60 months

R/z-score-length-for-age.R

@@ -17,7 +17,8 @@ anthro_zscore_length_for_age <-
     age_in_months,
     sex,
     flag_threshold = 6,
-    growthstandards = growthstandards_lenanthro
+    growthstandards = growthstandards_lenanthro,
+    z_precision = 2L
   ) {
     anthro_zscore_adjusted(
       name = "len",
@@ -28,6 +29,7 @@ anthro_zscore_length_for_age <-
       growthstandards = growthstandards,
       flag_threshold = flag_threshold,
       allowed_age_range = c(0, 1856),
-      zscore_fun = compute_zscore
+      zscore_fun = compute_zscore,
+      z_precision = z_precision
     )
   }

R/z-score-subscapular-skinfold-for-age.R

@@ -17,7 +17,8 @@ anthro_zscore_subscapular_skinfold_for_age <-
     age_in_months,
     sex,
     flag_threshold = 5,
-    growthstandards = growthstandards_ssanthro
+    growthstandards = growthstandards_ssanthro,
+    z_precision = 2L
   ) {
     anthro_zscore_adjusted(
       name = "ss",
@@ -27,6 +28,7 @@ anthro_zscore_subscapular_skinfold_for_age <-
       sex = sex,
       growthstandards = growthstandards,
       flag_threshold = flag_threshold,
-      allowed_age_range = c(91, 1856)
+      allowed_age_range = c(91, 1856),
+      z_precision = z_precision
     )
   }

R/z-score-triceps-skinfold-for-age.R

@@ -17,7 +17,8 @@ anthro_zscore_triceps_skinfold_for_age <-
     age_in_months,
     sex,
     flag_threshold = 5,
-    growthstandards = growthstandards_tsanthro
+    growthstandards = growthstandards_tsanthro,
+    z_precision = 2L
   ) {
     anthro_zscore_adjusted(
       name = "ts",
@@ -27,6 +28,7 @@ anthro_zscore_triceps_skinfold_for_age <-
       sex = sex,
       growthstandards = growthstandards,
       flag_threshold = flag_threshold,
-      allowed_age_range = c(91, 1856)
+      allowed_age_range = c(91, 1856),
+      z_precision = z_precision
     )
   }

R/z-score-weight-for-age.R

@@ -18,7 +18,8 @@ anthro_zscore_weight_for_age <-
     sex,
     oedema,
     flag_threshold = c(-6, 5),
-    growthstandards = growthstandards_weianthro
+    growthstandards = growthstandards_weianthro,
+    z_precision = 2L
   ) {
     anthro_zscore_adjusted(
       "wei",
@@ -29,6 +30,7 @@ anthro_zscore_weight_for_age <-
       growthstandards,
       flag_threshold,
       allowed_age_range = c(0, 1856),
-      !(oedema %in% "y")
+      !(oedema %in% "y"),
+      z_precision = z_precision
     )
   }

R/z-score-weight-for-lenhei.R

@@ -25,7 +25,8 @@ anthro_zscore_weight_for_lenhei <-
     oedema,
     flag_threshold = 5,
     growthstandards_wfl = growthstandards_wflanthro,
-    growthstandards_wfh = growthstandards_wfhanthro
+    growthstandards_wfh = growthstandards_wfhanthro,
+    z_precision = 2L
   ) {
     stopifnot(is.numeric(weight))
     stopifnot(is.numeric(weight))
@@ -127,8 +128,8 @@ anthro_zscore_weight_for_lenhei <-
     )
     s <- as.numeric(s)
 
-    zscore <- compute_zscore_adjusted(y, m, l, s)
-    zscore <- round(zscore, digits = 2L)
+    zscore <- compute_zscore_adjusted(y, m, l, s, z_precision = z_precision)
+    zscore <- round(zscore, digits = z_precision)
 
     valid_zscore <- !is.na(lenhei) &
       ifelse(

R/z-score.R

@@ -83,6 +83,7 @@
 #'             BUT they are treated as being < -3 SD in the weight-related
 #'             indicator prevalence (\code{\link{anthro_prevalence}})
 #'             estimation.
+#' @param z_precision An integer specifying the number of digits to round the z-scores to. The default value is 2. It must be a non-negative integer.
 #'
 #' @return A `data.frame` with three types of columns: columns starting with a
 #' "c" are cleaned versions of the input arguments
@@ -168,7 +169,8 @@ anthro_zscores <- function(
   armc = NA_real_,
   triskin = NA_real_,
   subskin = NA_real_,
-  oedema = "n"
+  oedema = "n",
+  z_precision = 2L
 ) {
   assert_logical(is_age_in_month)
   assert_length(is_age_in_month, 1L)
@@ -199,6 +201,11 @@ anthro_zscores <- function(
     allowed = c("n", "y", "N", "Y", "2", "1", NA_character_)
   )
 
+  # ensure z_precision is an integer >= 0
+  assert_numeric(z_precision)
+  z_precision <- as.integer(z_precision)
+  stopifnot(!is.na(z_precision) && z_precision >= 0)
+
   # make all input lengths equal
   max_len <- pmax(
     length(sex),
@@ -262,14 +269,16 @@ anthro_zscores <- function(
       lenhei = clenhei,
       age_in_days = age_in_days,
       age_in_months = age_in_months,
-      sex = csex
+      sex = csex,
+      z_precision = z_precision
     ),
     anthro_zscore_weight_for_age(
       weight = weight,
       age_in_days = age_in_days,
       age_in_months = age_in_months,
       sex = csex,
-      oedema = oedema
+      oedema = oedema,
+      z_precision = z_precision
     ),
     anthro_zscore_weight_for_lenhei(
       weight = weight,
@@ -278,38 +287,44 @@ anthro_zscores <- function(
       age_in_days = age_in_days,
       age_in_months = age_in_months,
       sex = csex,
-      oedema = oedema
+      oedema = oedema,
+      z_precision = z_precision
     ),
     anthro_zscore_bmi_for_age(
       bmi = cbmi,
       age_in_days = age_in_days,
       age_in_months = age_in_months,
       sex = csex,
-      oedema = oedema
+      oedema = oedema,
+      z_precision = z_precision
     ),
     anthro_zscore_head_circumference_for_age(
       headc,
       age_in_days = age_in_days,
       age_in_months = age_in_months,
-      sex = csex
+      sex = csex,
+      z_precision = z_precision
     ),
     anthro_zscore_arm_circumference_for_age(
       armc = armc,
       age_in_days = age_in_days,
       age_in_months = age_in_months,
-      sex = csex
+      sex = csex,      
+      z_precision = z_precision
     ),
     anthro_zscore_triceps_skinfold_for_age(
       triskin = triskin,
       age_in_days = age_in_days,
       age_in_months = age_in_months,
-      sex = csex
+      sex = csex,
+      z_precision = z_precision
     ),
     anthro_zscore_subscapular_skinfold_for_age(
       subskin = subskin,
       age_in_days = age_in_days,
       age_in_months = age_in_months,
-      sex = csex
+      sex = csex,
+      z_precision = z_precision
     ),
     stringsAsFactors = FALSE
   )