Precision

DESCRIPTION

@@ -18,7 +18,7 @@ Description: Provides WHO 2007 References for School-age Children and
 License: GPL (>= 3)
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.3.2
+RoxygenNote: 7.3.3
 Depends: 
     R (>= 3.5.0)
 Imports:

R/prevalence.R

@@ -24,7 +24,12 @@
 #' (including) are used for the analysis. The rest will be ignored.
 #'
 #' @inheritParams anthroplus_zscores
-#'
+
+#' @param z_precision An integer (use an integer literal, e.g. 3L) specifying the number
+#' of digits to round z-scores to in the prevalence output. The default
+#' is 2L. Non-integer numeric values are not accepted; pass an integer like
+#' `3L`.
+
 #' @param sw An optional numeric vector containing the sampling weights.
 #' If NULL, no sampling weights are used.
 #'
@@ -108,6 +113,7 @@ anthroplus_prevalence <- function(sex,
                                   oedema = "n",
                                   height_in_cm = NA_real_,
                                   weight_in_kg = NA_real_,
+                                  z_precision = 2L,
                                   sw = NULL,
                                   cluster = NULL,
                                   strata = NULL) {
@@ -119,6 +125,7 @@ anthroplus_prevalence <- function(sex,
   stopifnot(is.null(cluster) || is.numeric(cluster))
   stopifnot(is.null(strata) || is.numeric(strata))
   stopifnot(is.null(sw) || is.numeric(sw))
+  stopifnot(is.integer(z_precision) && z_precision >= 0)
 
   input <- data.frame(sex, age_in_months, oedema, height_in_cm, weight_in_kg)
   if (!is.null(cluster)) {
@@ -149,7 +156,8 @@ anthroplus_prevalence <- function(sex,
   }
   zscores <- anthroplus_zscores(
     input$sex, input$age_in_months,
-    input$oedema, input$height_in_cm, input$weight_in_kg
+    input$oedema, input$height_in_cm, input$weight_in_kg,
+    z_precision = z_precision
   )
   # age in months is also part of the z-score output
   zscores$age_in_months <- NULL

R/zscores.R

@@ -26,6 +26,8 @@
 #' @param weight_in_kg A numeric variable containing body weight information,
 #'               which must be in kilograms. Weight-related z-scores are not
 #'               calculated if missing.
+#' @param z_precision An integer (use an integer literal, e.g. 3L) specifying the number of digits to round the z-scores to. The default is 2L.
+#' Non-integer numeric values (for example `3`) are not accepted; pass an integer like `3L`.
 #'
 #' @details
 #' The following age cutoffs are used:
@@ -74,12 +76,14 @@ anthroplus_zscores <- function(sex,
                                age_in_months = NA_real_,
                                oedema = NA_character_,
                                height_in_cm = NA_real_,
-                               weight_in_kg = NA_real_) {
+                               weight_in_kg = NA_real_,
+                               z_precision = 2L) {
   stopifnot(all(tolower(sex) %in% c("1", "2", "f", "m", NA_character_)))
   stopifnot(all(tolower(oedema) %in% c("1", "2", "y", "n", NA_character_)))
   stopifnot(all(age_in_months >= 0, na.rm = TRUE))
   stopifnot(all(height_in_cm >= 0, na.rm = TRUE))
   stopifnot(all(weight_in_kg >= 0, na.rm = TRUE))
+  stopifnot(is.integer(z_precision) && z_precision >= 0)
 
   input <- data.frame(sex, age_in_months, oedema, height_in_cm, weight_in_kg)
 
@@ -89,20 +93,23 @@ anthroplus_zscores <- function(sex,
 
   zhfa <- zscore_height_for_age(
     sex = csex, age_in_months = input$age_in_months,
-    height = input$height_in_cm
+    height = input$height_in_cm,
+    z_precision = z_precision
   )
   zwfa <- zscore_weight_for_age(
     sex = csex, age_in_months = input$age_in_months,
-    oedema = coedema, weight = input$weight_in_kg
+    oedema = coedema, weight = input$weight_in_kg,
+    z_precision = z_precision
   )
   zbfa <- zscore_bmi_for_age(
     sex = csex, age_in_months = input$age_in_months,
-    oedema = coedema, bmi = cbmi
+    oedema = coedema, bmi = cbmi,
+    z_precision = z_precision
   )
 
-  zhfa <- round(zhfa, digits = 2L)
-  zwfa <- round(zwfa, digits = 2L)
-  zbfa <- round(zbfa, digits = 2L)
+  zhfa <- round(zhfa, digits = z_precision)
+  zwfa <- round(zwfa, digits = z_precision)
+  zbfa <- round(zbfa, digits = z_precision)
 
   fhfa <- flag_scores(zhfa, !is.na(zhfa) & abs(zhfa) > 6)
   fwfa <- flag_scores(zwfa, !is.na(zwfa) & (zwfa > 5 | zwfa < -6))
@@ -140,33 +147,36 @@ WFA_UPPER_AGE_LIMIT <- 121
 
 #' @importFrom anthro anthro_api_compute_zscore_adjusted
 zscore_weight_for_age <- function(sex, age_in_months, oedema,
-                                  weight) {
+                                  weight, z_precision = 2L) {
   weight[oedema == "y"] <- NA_real_
   zscore_indicator(sex, age_in_months, weight,
     wfa_growth_standards,
     age_upper_bound = WFA_UPPER_AGE_LIMIT,
-    zscore_fun = anthro_api_compute_zscore_adjusted
+    zscore_fun = anthro_api_compute_zscore_adjusted,
+    z_precision = z_precision
   )
 }
 
 #' @importFrom anthro anthro_api_compute_zscore
 zscore_height_for_age <- function(sex, age_in_months,
-                                  height) {
+                                  height, z_precision = 2L) {
   zscore_indicator(sex, age_in_months, height,
     hfa_growth_standards,
     age_upper_bound = 229,
-    zscore_fun = anthro_api_compute_zscore
+    zscore_fun = anthro_api_compute_zscore,
+    z_precision = z_precision
   )
 }
 
 #' @importFrom anthro anthro_api_compute_zscore_adjusted
 zscore_bmi_for_age <- function(sex, age_in_months, oedema,
-                               bmi) {
+                               bmi, z_precision = 2L) {
   bmi[oedema == "y"] <- NA_real_
   zscore_indicator(sex, age_in_months, bmi,
     bfa_growth_standards,
     age_upper_bound = 229,
-    zscore_fun = anthro_api_compute_zscore_adjusted
+    zscore_fun = anthro_api_compute_zscore_adjusted,
+    z_precision = z_precision
   )
 }
 
@@ -175,7 +185,8 @@ zscore_indicator <- function(sex,
                              measure,
                              growth_standards,
                              age_upper_bound,
-                             zscore_fun) {
+                             zscore_fun,
+                             z_precision = 2L) {
   low_age <- trunc(age_in_months)
   upp_age <- trunc(age_in_months + 1)
   diff_age <- age_in_months - low_age
@@ -213,7 +224,7 @@ zscore_indicator <- function(sex,
     l[is_diff_age_pos] <- adjust_param(l)
     s[is_diff_age_pos] <- adjust_param(s)
   }
-  zscores <- zscore_fun(measure, m, l, s)
+  zscores <- zscore_fun(measure, m, l, s, z_precision = z_precision)
   has_invalid_valid_age <- is.na(age_in_months) |
     !(age_in_months >= 60 & age_in_months < age_upper_bound)
   zscores[has_invalid_valid_age] <- NA_real_

README.Rmd

@@ -57,6 +57,22 @@ anthroplus_zscores(
 )
 ```
 
+The functions support a `z_precision` parameter to control the number of
+decimal places returned for z-scores. `z_precision` must be an integer
+literal (for example `3L` or `4L`). By default z-scores are returned with
+two decimal places; set `z_precision` to a higher integer literal when you
+need more precision in the results.
+
+```{r example-zprecision}
+anthroplus_zscores(
+  sex = c("1", "f"),
+  age_in_months = c(100, 110),
+  height_in_cm = c(100, 90),
+  weight_in_kg = c(30, 40),
+  z_precision = 4L
+)
+```
+
 The returned value is a `data.frame` that can further be processed or
 saved as a `.csv` file.
 
@@ -89,6 +105,22 @@ anthroplus_prevalence(
 )[, c(1, 4, 5, 6)]
 ```
 
+The `anthroplus_prevalence` function also accepts `z_precision` which will
+control how z-scores displayed within prevalence tables are rounded. `z_precision`
+must be an integer literal (for example `3L`). Use `z_precision` when you
+need prevalence outputs that display z-scores with more than the default
+two decimal places.
+
+```{r example-prevalence-zprecision}
+anthroplus_prevalence(
+  sex = c(1, 2),
+  age_in_months = rpois(100, 100),
+  height_in_cm = rnorm(100, 100, 10),
+  weight_in_kg = rnorm(100, 40, 10),
+  z_precision = 3L
+)[, c(1, 4, 5, 6)]
+```
+
 Using the function `with` it is easy to apply `anthroplus_prevalence` to a
 full dataset.
 

tests/testthat/test-zscores.R

@@ -32,6 +32,22 @@ test_that("computes correct value for age ~ 60 months", {
   expect_equal(res$fhfa, c(0, 0))
 })
 
+test_that("computes correct value for age ~ 60 months and precision of 3dp", {
+  res <- anthroplus_zscores(
+    sex = c(2, 2),
+    age_in_months = c(60.32, 60.911701),
+    height_in_cm = c(113.8, 113.6),
+    weight_in_kg = c(18.7, 20.5),
+    z_precision = 3L
+  )
+  expect_equal(res$zwfa, c(0.212, 0.795))
+  expect_equal(res$fwfa, c(0, 0))
+  expect_equal(res$zbfa, c(-0.575, 0.418))
+  expect_equal(res$fbfa, c(0, 0))
+  expect_equal(res$zhfa, c(0.959, 0.848))
+  expect_equal(res$fhfa, c(0, 0))
+})
+
 test_that("different sex encodings work", {
   expect_equal(
     anthroplus_zscores(1, 120, height_in_cm = 60, weight_in_kg = 30),
@@ -147,3 +163,32 @@ test_that("age < 60 months results in all NA scores and flags", {
   expect_true(is.na(res$fwfa))
   expect_true(is.na(res$fbfa))
 })
+
+test_that("z_precision validation: non-integer and negative values are rejected", {
+  # non-integer numeric (double) should error
+  expect_error(anthroplus_zscores(
+    sex = 2,
+    age_in_months = 60,
+    height_in_cm = 120,
+    weight_in_kg = 30,
+    z_precision = 3
+  ))
+
+  # negative integer should error
+  expect_error(anthroplus_zscores(
+    sex = 2,
+    age_in_months = 60,
+    height_in_cm = 120,
+    weight_in_kg = 30,
+    z_precision = -1L
+  ))
+
+  # accept integer literal
+  expect_silent(anthroplus_zscores(
+    sex = 2,
+    age_in_months = 60,
+    height_in_cm = 120,
+    weight_in_kg = 30,
+    z_precision = 3L
+  ))
+})