diff --git a/NEWS.md b/NEWS.md index 576d57b..ac31148 100644 --- a/NEWS.md +++ b/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 diff --git a/R/prevalence.R b/R/prevalence.R index 76d7514..213e62d 100644 --- a/R/prevalence.R +++ b/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, diff --git a/R/zscores.R b/R/zscores.R index 2c87484..1c2e2ea 100644 --- a/R/zscores.R +++ b/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 } diff --git a/tests/testthat/helpers.R b/tests/testthat/helpers.R index e5471d6..d0f9609 100644 --- a/tests/testthat/helpers.R +++ b/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 diff --git a/tests/testthat/test-prevalence.R b/tests/testthat/test-prevalence.R index 06a2975..bcf1ee2 100644 --- a/tests/testthat/test-prevalence.R +++ b/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" + ) +}) diff --git a/tests/testthat/test-zscores.R b/tests/testthat/test-zscores.R index 1f4266f..3821909 100644 --- a/tests/testthat/test-zscores.R +++ b/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 )