From e43636bc419e3288bae1eca084ca0ac6a1b1c47d Mon Sep 17 00:00:00 2001 From: eatyourpeas Date: Tue, 17 Feb 2026 21:42:35 +0000 Subject: [PATCH 1/3] refactors functions to accept z_precision param. fixes tests --- R/api.R | 3 +++ R/z-score-arm-circumference-for-age.R | 6 +++-- R/z-score-bmi-for-age.R | 6 +++-- R/z-score-head-circumference-for-age.R | 6 +++-- R/z-score-helper.R | 19 +++++++++----- R/z-score-length-for-age.R | 6 +++-- R/z-score-subscapular-skinfold-for-age.R | 6 +++-- R/z-score-triceps-skinfold-for-age.R | 6 +++-- R/z-score-weight-for-age.R | 6 +++-- R/z-score-weight-for-lenhei.R | 7 ++--- R/z-score.R | 33 +++++++++++++++++------- tests/testthat/test-z-precision.R | 21 +++++++++++++++ 12 files changed, 92 insertions(+), 33 deletions(-) create mode 100644 tests/testthat/test-z-precision.R diff --git a/R/api.R b/R/api.R index 5624faf..c9d57d2 100644 --- a/R/api.R +++ b/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 diff --git a/R/z-score-arm-circumference-for-age.R b/R/z-score-arm-circumference-for-age.R index 0797f61..a603284 100644 --- a/R/z-score-arm-circumference-for-age.R +++ b/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 ) } diff --git a/R/z-score-bmi-for-age.R b/R/z-score-bmi-for-age.R index 2d3246a..5f2300c 100644 --- a/R/z-score-bmi-for-age.R +++ b/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 ) } diff --git a/R/z-score-head-circumference-for-age.R b/R/z-score-head-circumference-for-age.R index a775d16..dbb6b09 100644 --- a/R/z-score-head-circumference-for-age.R +++ b/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 ) } diff --git a/R/z-score-helper.R b/R/z-score-helper.R index ae4539b..0182877 100644 --- a/R/z-score-helper.R +++ b/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,9 @@ 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.integer(z_precision) && z_precision >= 0) calc_sd <- function(sd) m * ((1 + l * s * sd)^(1 / l)) zscore <- compute_zscore(y, m, l, s) @@ -42,6 +43,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 +52,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 +73,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 +138,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 +169,8 @@ anthro_zscore_adjusted <- growthstandards, age_in_days, sex, - measure + measure, + z_precision = z_precision ) # we only compute zscores for children age < 60 months diff --git a/R/z-score-length-for-age.R b/R/z-score-length-for-age.R index 1e78a45..7e745be 100644 --- a/R/z-score-length-for-age.R +++ b/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 ) } diff --git a/R/z-score-subscapular-skinfold-for-age.R b/R/z-score-subscapular-skinfold-for-age.R index 23d90e5..6256c0f 100644 --- a/R/z-score-subscapular-skinfold-for-age.R +++ b/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 ) } diff --git a/R/z-score-triceps-skinfold-for-age.R b/R/z-score-triceps-skinfold-for-age.R index 9506d4d..d91a809 100644 --- a/R/z-score-triceps-skinfold-for-age.R +++ b/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 ) } diff --git a/R/z-score-weight-for-age.R b/R/z-score-weight-for-age.R index e05ca1d..e28e8be 100644 --- a/R/z-score-weight-for-age.R +++ b/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 ) } diff --git a/R/z-score-weight-for-lenhei.R b/R/z-score-weight-for-lenhei.R index c17d4e2..b6dea8c 100644 --- a/R/z-score-weight-for-lenhei.R +++ b/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( diff --git a/R/z-score.R b/R/z-score.R index 992cb2a..88f3439 100644 --- a/R/z-score.R +++ b/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 ) diff --git a/tests/testthat/test-z-precision.R b/tests/testthat/test-z-precision.R new file mode 100644 index 0000000..82f8042 --- /dev/null +++ b/tests/testthat/test-z-precision.R @@ -0,0 +1,21 @@ +test_that("z_precision accepts more decimal places and affects z-scores", { + res2 <- anthro_zscores(sex = "f", age = 10, is_age_in_month = TRUE, weight = 10, z_precision = 2L) + res4 <- anthro_zscores(sex = "f", age = 10, is_age_in_month = TRUE, weight = 10, z_precision = 4L) + + expect_true(!identical(res2$zwei, res4$zwei)) + expect_equal(res4$zwei, round(res4$zwei, 4)) +}) + +test_that("z_precision = 0 returns integer z-scores (rounded to 0 digits)", { + res0 <- anthro_zscores(sex = "f", age = 10, is_age_in_month = TRUE, weight = 10, z_precision = 0L) + expect_equal(res0$zwei, round(res0$zwei, 0)) +}) + +test_that("negative z_precision is rejected", { + expect_error(anthro_zscores(sex = "f", age = 10, is_age_in_month = TRUE, weight = 10, z_precision = -1L)) +}) + +test_that("non-integer numeric z_precision is rejected", { + # passing 3 (numeric double) should be rejected because internal checks expect integer + expect_error(anthro_zscores(sex = "f", age = 10, is_age_in_month = TRUE, weight = 10, z_precision = 3)) +}) From 6b16167501da8e3ca0eea216eda88485dfc4a557 Mon Sep 17 00:00:00 2001 From: eatyourpeas Date: Tue, 17 Feb 2026 21:46:18 +0000 Subject: [PATCH 2/3] adds test for more precision, test negative validation --- R/z-score-helper.R | 4 +++- tests/testthat/test-z-precision.R | 6 +++--- 2 files changed, 6 insertions(+), 4 deletions(-) diff --git a/R/z-score-helper.R b/R/z-score-helper.R index 0182877..2d5a7dd 100644 --- a/R/z-score-helper.R +++ b/R/z-score-helper.R @@ -27,7 +27,9 @@ compute_zscore <- function(y, m, l, s, ...) { #' @noRd 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.integer(z_precision) && z_precision >= 0) + 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) diff --git a/tests/testthat/test-z-precision.R b/tests/testthat/test-z-precision.R index 82f8042..bddb909 100644 --- a/tests/testthat/test-z-precision.R +++ b/tests/testthat/test-z-precision.R @@ -15,7 +15,7 @@ test_that("negative z_precision is rejected", { expect_error(anthro_zscores(sex = "f", age = 10, is_age_in_month = TRUE, weight = 10, z_precision = -1L)) }) -test_that("non-integer numeric z_precision is rejected", { - # passing 3 (numeric double) should be rejected because internal checks expect integer - expect_error(anthro_zscores(sex = "f", age = 10, is_age_in_month = TRUE, weight = 10, z_precision = 3)) +test_that("non-integer numeric z_precision is accepted and coerced to integer", { + res3 <- anthro_zscores(sex = "f", age = 10, is_age_in_month = TRUE, weight = 10, z_precision = 3) + expect_equal(res3$zwei, round(res3$zwei, 3)) }) From 2a2a555024c0dc5984e73d111a4e2301dc723d9f Mon Sep 17 00:00:00 2001 From: eatyourpeas Date: Sat, 11 Apr 2026 13:25:56 +0100 Subject: [PATCH 3/3] generate docs --- DESCRIPTION | 2 +- man/anthro_api_compute_prevalence.Rd | 1 + man/anthro_api_compute_zscore.Rd | 4 +++- man/anthro_api_compute_zscore_adjusted.Rd | 4 +++- man/anthro_zscores.Rd | 5 ++++- 5 files changed, 12 insertions(+), 4 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index b540af8..c9c9f6e 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -23,7 +23,7 @@ Imports: survey Suggests: testthat -RoxygenNote: 7.3.2 +RoxygenNote: 7.3.3 Collate: 'anthro-package.R' 'utils.R' diff --git a/man/anthro_api_compute_prevalence.Rd b/man/anthro_api_compute_prevalence.Rd index 6fc9cc0..5c8ed5c 100644 --- a/man/anthro_api_compute_prevalence.Rd +++ b/man/anthro_api_compute_prevalence.Rd @@ -21,6 +21,7 @@ The list needs to have 4 named values: -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.} }} \item{survey_subsets}{subsets for which the prevalence values should be diff --git a/man/anthro_api_compute_zscore.Rd b/man/anthro_api_compute_zscore.Rd index d61c7e8..69b7546 100644 --- a/man/anthro_api_compute_zscore.Rd +++ b/man/anthro_api_compute_zscore.Rd @@ -4,7 +4,7 @@ \alias{anthro_api_compute_zscore} \title{Helper function to compute zscores} \usage{ -anthro_api_compute_zscore(y, m, l, s) +anthro_api_compute_zscore(y, m, l, s, ...) } \arguments{ \item{y}{a numeric vector} @@ -14,6 +14,8 @@ anthro_api_compute_zscore(y, m, l, s) \item{l}{a numeric vector} \item{s}{a numeric vector} + +\item{z_precision}{number of digits to round the zscore to. If NULL, 2 digits are used.} } \description{ Helper function to compute zscores diff --git a/man/anthro_api_compute_zscore_adjusted.Rd b/man/anthro_api_compute_zscore_adjusted.Rd index 2d0fa33..68fc280 100644 --- a/man/anthro_api_compute_zscore_adjusted.Rd +++ b/man/anthro_api_compute_zscore_adjusted.Rd @@ -4,7 +4,7 @@ \alias{anthro_api_compute_zscore_adjusted} \title{Helper function to compute the adjusted zscore} \usage{ -anthro_api_compute_zscore_adjusted(y, m, l, s) +anthro_api_compute_zscore_adjusted(y, m, l, s, z_precision = 2L) } \arguments{ \item{y}{a numeric vector} @@ -14,6 +14,8 @@ anthro_api_compute_zscore_adjusted(y, m, l, s) \item{l}{a numeric vector} \item{s}{a numeric vector} + +\item{z_precision}{number of digits to round the zscore to. If NULL, 2 digits are used.} } \description{ Helper function to compute the adjusted zscore diff --git a/man/anthro_zscores.Rd b/man/anthro_zscores.Rd index 2ad24e3..43316f8 100644 --- a/man/anthro_zscores.Rd +++ b/man/anthro_zscores.Rd @@ -15,7 +15,8 @@ anthro_zscores( armc = NA_real_, triskin = NA_real_, subskin = NA_real_, - oedema = "n" + oedema = "n", + z_precision = 2L ) } \arguments{ @@ -104,6 +105,8 @@ treated as non-oedema. For oedema, weight related z-scores BUT they are treated as being < -3 SD in the weight-related indicator prevalence (\code{\link{anthro_prevalence}}) estimation.} + +\item{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.} } \value{ A `data.frame` with three types of columns: columns starting with a