Increase age upper bound to <229

NEWS.md

@@ -1,5 +1,8 @@
 # anthroplus (development version)
 
+* Increased the upper age limit to 229 months exclusive
+  from 228 months inclusive.
+
 # anthroplus 1.0.0
 
 * The package now supports observations with age >= 60 months. Previously there

R/prevalence.R

@@ -133,17 +133,17 @@ anthroplus_prevalence <- function(sex,
   old_rows <- nrow(input)
   input <- input[!is.na(input$age_in_months) &
     input$age_in_months >= 60 &
-    input$age_in_months <= 228, , drop = FALSE]
+    input$age_in_months < 229, , drop = FALSE]
   if (nrow(input) == 0) {
     stop(
-      "All age values are either NA or < 60 or > 228, which excludes all",
+      "All age values are either NA or < 60 or >= 229, which excludes all",
       " cases from the analysis.",
       call. = FALSE
     )
   } else if (nrow(input) < old_rows) {
     warning(
       old_rows - nrow(input),
-      " row(s) with age NA or age < 60 months or > 228 months were excluded",
+      " row(s) with age NA or age < 60 months or >= 229 months were excluded",
       " from the computation."
     )
   }
@@ -283,7 +283,7 @@ prev_age_group_labels <- c(
 )
 
 prev_age_groups <- function(age_in_months) {
-  stopifnot(is.numeric(age_in_months), all(age_in_months <= 228, na.rm = TRUE))
+  stopifnot(is.numeric(age_in_months), all(age_in_months < 229, na.rm = TRUE))
   cut_breaks <- c(
     60, 72, 84, 96, 108, 120, 132,
     144, 156, 168, 180, 192, 204, 216, 228, 229
@@ -302,7 +302,7 @@ prev_wider_age_group_labels <- c(
 )
 
 prev_wider_age_groups <- function(age_in_months) {
-  stopifnot(is.numeric(age_in_months), all(age_in_months <= 228, na.rm = TRUE))
+  stopifnot(is.numeric(age_in_months), all(age_in_months < 229, na.rm = TRUE))
   cut_breaks <- c(60, 120, 180, 229)
   cut(age_in_months,
     breaks = cut_breaks,

R/zscores.R

@@ -145,6 +145,7 @@ 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
   )
 }
@@ -154,7 +155,8 @@ zscore_height_for_age <- function(sex, age_in_months,
                                   height) {
   zscore_indicator(sex, age_in_months, height,
     hfa_growth_standards,
-    age_upper_bound = 228,
+    age_upper_bound = 229,
+    age_comparison_fun = `<`,
     zscore_fun = anthro_api_compute_zscore
   )
 }
@@ -165,7 +167,8 @@ zscore_bmi_for_age <- function(sex, age_in_months, oedema,
   bmi[oedema == "y"] <- NA_real_
   zscore_indicator(sex, age_in_months, bmi,
     bfa_growth_standards,
-    age_upper_bound = 228,
+    age_upper_bound = 229,
+    age_comparison_fun = `<`,
     zscore_fun = anthro_api_compute_zscore_adjusted
   )
 }
@@ -175,7 +178,8 @@ zscore_indicator <- function(sex,
                              measure,
                              growth_standards,
                              age_upper_bound,
-                             zscore_fun) {
+                             zscore_fun,
+                             age_comparison_fun = `<=`) {
   low_age <- trunc(age_in_months)
   upp_age <- trunc(age_in_months + 1)
   diff_age <- age_in_months - low_age
@@ -215,7 +219,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_in_months <= age_upper_bound)
+    !(age_in_months >= 60 & age_comparison_fun(age_in_months, age_upper_bound))
   zscores[has_invalid_valid_age] <- NA_real_
   zscores
 }

tests/testthat/helpers.R

@@ -3,17 +3,15 @@ check_with_survey <- function(input,
                               sampling_weights = NULL,
                               cluster = NULL,
                               strata = NULL) {
-  expect_warning(
-    res <- anthroplus_prevalence(
-      input$sex,
-      input$agemons,
-      input$oedema,
-      input$height,
-      input$weight,
-      sw = sampling_weights,
-      cluster = cluster,
-      strata = strata
-    ), "excluded"
+  res <- anthroplus_prevalence(
+    input$sex,
+    input$agemons,
+    input$oedema,
+    input$height,
+    input$weight,
+    sw = sampling_weights,
+    cluster = cluster,
+    strata = strata
   )
   zscores <- anthroplus_zscores(
     input$sex,
@@ -37,7 +35,7 @@ check_with_survey <- function(input,
     zscores$strata <- strata
     ~strata
   }
-  zscores <- zscores[zscores$agemons <= 228, ]
+  zscores <- zscores[zscores$agemons < 229, ]
   design <- survey::svydesign(
     id = cluster, data = zscores,
     weights = sw, strata = strata, nest = TRUE

tests/testthat/test-prevalence.R

@@ -35,7 +35,7 @@ test_that("strata are considered correctly", {
 test_that("age only between 60 and 229 is considered", {
   input <- readRDS("test_dataset_who2007.rds")
   input$agemons <- input$agemons * 2
-  input_filtered <- input[input$agemons >= 60 & input$agemons <= 228, ]
+  input_filtered <- input[input$agemons >= 60 & input$agemons < 229, ]
   expect_warning(
     res1 <- anthroplus_prevalence(
       input$sex,
@@ -217,3 +217,18 @@ test_that("age in months = 60 is part of the age group", {
   expect_false(is.na(prev_wider_age_groups(60)))
   expect_false(is.na(prev_age_groups(60)))
 })
+
+test_that("age between 228 and < 229 are included", {
+  expect_warning(
+    {
+      res <- anthroplus_prevalence(
+        c("1", "2", "2", "1"),
+        c(228.1, 228.2, 228.9, 229),
+        "n",
+        100,
+        35
+      )
+    },
+    "1 row"
+  )
+})

tests/testthat/test-zscores.R

@@ -1,10 +1,6 @@
 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$zhfa[data$agemons > 228] <- NA_real_
-  data$fhfa[data$agemons > 228] <- NA_real_
-  data$zbfa[data$agemons > 228] <- NA_real_
-  data$fbfa[data$agemons > 228] <- NA_real_
   data$zwfa[data$agemons > 120] <- NA_real_
   data$fwfa[data$agemons > 120] <- NA_real_
   result <- anthroplus_zscores(
@@ -119,9 +115,9 @@ test_that("oedema = y implies NA for weight-for-age and bmi-for-age", {
   expect_false(is.na(res2$fbfa))
 })
 
-test_that("age upper bounds are inclusive", {
+test_that("age upper bounds are exclusive", {
   res <- anthroplus_zscores(
-    1, c(120, 228, 120.1, 228.1),
+    1, c(120, 228.5, 120.1, 229),
     height_in_cm = 60,
     weight_in_kg = 30
   )