Make age upper bound check for WFA exclusive

WorldHealthOrganization · Jan 23, 2025 · ccfe20d · ccfe20d
1 parent 4e6a764
commit ccfe20d
Show file tree

Hide file tree

Showing 4 changed files with 8 additions and 14 deletions.
diff --git a/NEWS.md b/NEWS.md
@@ -1,7 +1,8 @@
 # anthroplus (development version)
 
 * Increased the upper age limit to 229 months exclusive
-  from 228 months inclusive.
+  from 228 months inclusive. Also the upper age limit of 121 months
+  for WFA is now exclusive.
 
 # anthroplus 1.0.0
 

diff --git a/R/prevalence.R b/R/prevalence.R
@@ -187,10 +187,10 @@ anthroplus_prevalence <- function(sex,
         name = "WA", column = "wfa",
         with_cutoffs = TRUE, with_auxiliary_zscore_column = TRUE,
         auxiliary_zscore_condition = function(dataframe) {
-          # for wfa the age limit is 120 and thus below 228.
+          # for wfa the age limit is 120 and thus below 229
           # we need to make sure z-scores are only set to -3.1 if the age is
           # in range
-          dataframe[["age_in_months"]] <= WFA_UPPER_AGE_LIMIT &
+          dataframe[["age_in_months"]] < WFA_UPPER_AGE_LIMIT &
             dataframe[["oedema"]] %in% "y"
         }
       ),

diff --git a/R/zscores.R b/R/zscores.R
@@ -136,7 +136,7 @@ compute_bmi <- function(weight, height) {
   weight / ((height / 100)^2)
 }
 
-WFA_UPPER_AGE_LIMIT <- 120
+WFA_UPPER_AGE_LIMIT <- 121
 
 #' @importFrom anthro anthro_api_compute_zscore_adjusted
 zscore_weight_for_age <- function(sex, age_in_months, oedema,
@@ -145,7 +145,6 @@ zscore_weight_for_age <- function(sex, age_in_months, oedema,
   zscore_indicator(sex, age_in_months, weight,
     wfa_growth_standards,
     age_upper_bound = WFA_UPPER_AGE_LIMIT,
-    age_comparison_fun = `<=`,
     zscore_fun = anthro_api_compute_zscore_adjusted
   )
 }
@@ -156,7 +155,6 @@ zscore_height_for_age <- function(sex, age_in_months,
   zscore_indicator(sex, age_in_months, height,
     hfa_growth_standards,
     age_upper_bound = 229,
-    age_comparison_fun = `<`,
     zscore_fun = anthro_api_compute_zscore
   )
 }
@@ -168,7 +166,6 @@ zscore_bmi_for_age <- function(sex, age_in_months, oedema,
   zscore_indicator(sex, age_in_months, bmi,
     bfa_growth_standards,
     age_upper_bound = 229,
-    age_comparison_fun = `<`,
     zscore_fun = anthro_api_compute_zscore_adjusted
   )
 }
@@ -178,8 +175,7 @@ zscore_indicator <- function(sex,
                              measure,
                              growth_standards,
                              age_upper_bound,
-                             zscore_fun,
-                             age_comparison_fun = `<=`) {
+                             zscore_fun) {
   low_age <- trunc(age_in_months)
   upp_age <- trunc(age_in_months + 1)
   diff_age <- age_in_months - low_age
@@ -219,7 +215,7 @@ zscore_indicator <- function(sex,
   }
   zscores <- zscore_fun(measure, m, l, s)
   has_invalid_valid_age <- is.na(age_in_months) |
-    !(age_in_months >= 60 & age_comparison_fun(age_in_months, age_upper_bound))
+    !(age_in_months >= 60 & age_in_months < age_upper_bound)
   zscores[has_invalid_valid_age] <- NA_real_
   zscores
 }
diff --git a/tests/testthat/test-zscores.R b/tests/testthat/test-zscores.R
@@ -1,8 +1,5 @@
 test_that("zscore references match from previous implementation", {
   data <- readRDS("test_dataset_who2007.rds")
-  # unlike the WHO 2007, the age upper limits are inclusive
-  data$zwfa[data$agemons > 120] <- NA_real_
-  data$fwfa[data$agemons > 120] <- NA_real_
   result <- anthroplus_zscores(
     sex = data$sex,
     age_in_months = data$agemons,
@@ -117,7 +114,7 @@ test_that("oedema = y implies NA for weight-for-age and bmi-for-age", {
 
 test_that("age upper bounds are exclusive", {
   res <- anthroplus_zscores(
-    1, c(120, 228.5, 120.1, 229),
+    1, c(120, 228.5, 121, 229),
     height_in_cm = 60,
     weight_in_kg = 30
   )