diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml index 271d466..8410326 100644 --- a/.github/workflows/R-CMD-check.yaml +++ b/.github/workflows/R-CMD-check.yaml @@ -2,9 +2,9 @@ # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help on: push: - branches: [main, master] + branches: [main] pull_request: - branches: [main, master] + branches: [main] name: R-CMD-check @@ -29,18 +29,15 @@ jobs: R_KEEP_PKG_SOURCE: yes steps: - - uses: actions/checkout@v2 - - - uses: r-lib/actions/setup-pandoc@v1 - - - uses: r-lib/actions/setup-r@v1 + - uses: actions/checkout@v4 + - uses: r-lib/actions/setup-pandoc@v2 + - uses: r-lib/actions/setup-r@v2 with: r-version: ${{ matrix.config.r }} http-user-agent: ${{ matrix.config.http-user-agent }} use-public-rspm: true - - - uses: r-lib/actions/setup-r-dependencies@v1 + - uses: r-lib/actions/setup-r-dependencies@v2 with: - extra-packages: rcmdcheck - - - uses: r-lib/actions/check-r-package@v1 + extra-packages: any::rcmdcheck + needs: check + - uses: r-lib/actions/check-r-package@v2 diff --git a/DESCRIPTION b/DESCRIPTION index 14f66e8..90634b6 100644 --- a/DESCRIPTION +++ b/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.1.2 +RoxygenNote: 7.3.2 Depends: R (>= 3.5.0) Imports: diff --git a/NEWS.md b/NEWS.md index aeccc82..394a0c1 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,8 @@ # anthroplus (development version) +* The package now supports observations with age >= 60 months. Previously there + was a cutoff at 61 months excluding observations with 60 months. + # anthroplus 0.9.0 * Initial release diff --git a/R/prevalence.R b/R/prevalence.R index f5416b7..76d7514 100644 --- a/R/prevalence.R +++ b/R/prevalence.R @@ -20,7 +20,7 @@ #' If not all parameter values have equal length, parameter values will be #' repeated to match the maximum length. #' -#' Only cases with age_in_months between 61 (including) and 228 months +#' Only cases with age_in_months between 60 (including) and 228 months #' (including) are used for the analysis. The rest will be ignored. #' #' @inheritParams anthroplus_zscores @@ -88,7 +88,7 @@ #' #' Note that weight-for-age results are NA for the groups "All" and the two #' "Sex" groups, as the indicator is only defined for age in months -#' between 61 and 120. +#' between 60 and 120. #' #' @examples #' set.seed(1) @@ -132,18 +132,18 @@ anthroplus_prevalence <- function(sex, } old_rows <- nrow(input) input <- input[!is.na(input$age_in_months) & - input$age_in_months >= 61 & + input$age_in_months >= 60 & input$age_in_months <= 228, , drop = FALSE] if (nrow(input) == 0) { stop( - "All age values are either NA or < 61 or > 228, which excludes all", + "All age values are either NA or < 60 or > 228, 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 < 61 months or > 228 months were excluded", + " row(s) with age NA or age < 60 months or > 228 months were excluded", " from the computation." ) } @@ -246,8 +246,8 @@ cbind_year_month_columns <- function(prev_results) { "Total (15-19)", "Total (15-19)" # female/male 3 ), `Months` = c( - "(61-228)", - "(61-228)", "(61-228)", + "(60-228)", + "(60-228)", "(60-228)", paste0("(", gsub(" mo", "", prev_age_group_labels, fixed = TRUE), ")"), wider_labels, c(wider_labels[1], wider_labels[1]), @@ -265,7 +265,7 @@ cbind_year_month_columns <- function(prev_results) { } prev_age_group_labels <- c( - "61-71 mo", + "60-71 mo", "72-83 mo", "84-95 mo", "96-107 mo", @@ -281,10 +281,11 @@ prev_age_group_labels <- c( "216-227 mo", "228-228 mo" ) + prev_age_groups <- function(age_in_months) { stopifnot(is.numeric(age_in_months), all(age_in_months <= 228, na.rm = TRUE)) cut_breaks <- c( - 61, 72, 84, 96, 108, 120, 132, + 60, 72, 84, 96, 108, 120, 132, 144, 156, 168, 180, 192, 204, 216, 228, 229 ) cut(age_in_months, @@ -295,13 +296,14 @@ prev_age_groups <- function(age_in_months) { } prev_wider_age_group_labels <- c( - "61-119 mo", + "60-119 mo", "120-179 mo", "180-228 mo" ) + prev_wider_age_groups <- function(age_in_months) { stopifnot(is.numeric(age_in_months), all(age_in_months <= 228, na.rm = TRUE)) - cut_breaks <- c(61, 120, 180, 229) + cut_breaks <- c(60, 120, 180, 229) cut(age_in_months, breaks = cut_breaks, labels = prev_wider_age_group_labels, diff --git a/R/sysdata.rda b/R/sysdata.rda index 5a5adbf..8464fb6 100644 Binary files a/R/sysdata.rda and b/R/sysdata.rda differ diff --git a/R/zscores.R b/R/zscores.R index 1da664c..2c87484 100644 --- a/R/zscores.R +++ b/R/zscores.R @@ -30,9 +30,9 @@ #' @details #' The following age cutoffs are used: #' \itemize{ -#' \item{Height-for-age} age between 61 and 228 months inclusive -#' \item{Weight-for-age} age between 61 and 120 months inclusive -#' \item{BMI-for-age} age between 61 and 228 months inclusive +#' \item{Height-for-age} age between 60 and 228 months inclusive +#' \item{Weight-for-age} age between 60 and 120 months inclusive +#' \item{BMI-for-age} age between 60 and 228 months inclusive #' } #' #' @return A data.frame with three types of columns. Columns starting with a @@ -215,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 >= 61 & 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/data-raw/growthstandards/bfawho2007.txt b/data-raw/growthstandards/bfawho2007.txt index 3d07781..f0dbe1a 100644 --- a/data-raw/growthstandards/bfawho2007.txt +++ b/data-raw/growthstandards/bfawho2007.txt @@ -1,4 +1,5 @@ sex age l m s +1 60 -0.7151 15.2679 0.08366 1 61 -0.7387 15.2641 0.08390 1 62 -0.7621 15.2616 0.08414 1 63 -0.7856 15.2604 0.08439 @@ -168,6 +169,7 @@ sex age l m s 1 227 -0.8578 22.1514 0.12939 1 228 -0.8419 22.1883 0.12948 1 229 -0.8419 22.1883 0.12948 +2 60 -0.8702 15.2453 0.09646 2 61 -0.8886 15.2441 0.09692 2 62 -0.9068 15.2434 0.09738 2 63 -0.9248 15.2433 0.09783 diff --git a/data-raw/growthstandards/hfawho2007.txt b/data-raw/growthstandards/hfawho2007.txt index fa79dae..a8b2704 100644 --- a/data-raw/growthstandards/hfawho2007.txt +++ b/data-raw/growthstandards/hfawho2007.txt @@ -1,4 +1,5 @@ sex age l m s +1 60 1 109.7265 0.04156 1 61 1 110.2647 0.04164 1 62 1 110.8006 0.04172 1 63 1 111.3338 0.04180 @@ -168,6 +169,7 @@ sex age l m s 1 227 1 176.5211 0.04142 1 228 1 176.5432 0.04134 1 229 1 176.5432 0.04134 +2 60 1 109.0725 0.04346 2 61 1 109.6016 0.04355 2 62 1 110.1258 0.04364 2 63 1 110.6451 0.04373 diff --git a/data-raw/growthstandards/package.R b/data-raw/growthstandards/package.R index d2e4681..af2bf49 100644 --- a/data-raw/growthstandards/package.R +++ b/data-raw/growthstandards/package.R @@ -2,7 +2,7 @@ check_df <- function(df) { stopifnot(all(colnames(df) == c("sex", "age", "l", "m", "s"))) stopifnot(all(apply(df, 2, is.numeric))) stopifnot(all(df[["sex"]] %in% c(1, 2))) - stopifnot(all(df[["age"]] > 60)) + stopifnot(all(df[["age"]] >= 60)) } bfa_growth_standards <- read.csv("data-raw/growthstandards/bfawho2007.txt", sep = "\t") diff --git a/data-raw/growthstandards/wfawho2007.txt b/data-raw/growthstandards/wfawho2007.txt index 79c4e56..f2893b6 100644 --- a/data-raw/growthstandards/wfawho2007.txt +++ b/data-raw/growthstandards/wfawho2007.txt @@ -1,4 +1,5 @@ sex age l m s +1 60 -0.1922 18.3328 0.12947 1 61 -0.2026 18.5057 0.12988 1 62 -0.2130 18.6802 0.13028 1 63 -0.2234 18.8563 0.13067 @@ -60,6 +61,7 @@ sex age l m s 1 119 -0.6752 30.8854 0.16213 1 120 -0.6764 31.1586 0.16305 1 121 -0.6764 31.1586 0.16305 +2 60 -0.4650 18.0823 0.14240 2 61 -0.4681 18.2579 0.14295 2 62 -0.4711 18.4329 0.14350 2 63 -0.4742 18.6073 0.14404 diff --git a/data-raw/test-data.R b/data-raw/test-data.R deleted file mode 100644 index 9c353fa..0000000 --- a/data-raw/test-data.R +++ /dev/null @@ -1,8 +0,0 @@ -test_dataset_who2007 <- read.csv("data-raw/survey_who2007_z.csv") -test_dataset_who2007$dob <- NULL -test_dataset_who2007$dov <- NULL -saveRDS( - test_dataset_who2007, - "inst/testdata/test_dataset_who2007.rds", - version = 3 -) diff --git a/man/anthroplus_prevalence.Rd b/man/anthroplus_prevalence.Rd index 4c67314..0541430 100644 --- a/man/anthroplus_prevalence.Rd +++ b/man/anthroplus_prevalence.Rd @@ -110,7 +110,7 @@ interval limit} Note that weight-for-age results are NA for the groups "All" and the two "Sex" groups, as the indicator is only defined for age in months -between 61 and 120. +between 60 and 120. } \description{ Prevalence estimates according to the WHO recommended standard analysis: @@ -133,7 +133,7 @@ estimates for the different groups (e.g. by age or sex). If not all parameter values have equal length, parameter values will be repeated to match the maximum length. -Only cases with age_in_months between 61 (including) and 228 months +Only cases with age_in_months between 60 (including) and 228 months (including) are used for the analysis. The rest will be ignored. } \examples{ diff --git a/man/anthroplus_zscores.Rd b/man/anthroplus_zscores.Rd index 852ff47..238eec9 100644 --- a/man/anthroplus_zscores.Rd +++ b/man/anthroplus_zscores.Rd @@ -76,9 +76,9 @@ Compute z-scores for age 5 to 19 \details{ The following age cutoffs are used: \itemize{ -\item{Height-for-age} age between 61 and 228 months inclusive -\item{Weight-for-age} age between 61 and 120 months inclusive -\item{BMI-for-age} age between 61 and 228 months inclusive +\item{Height-for-age} age between 60 and 228 months inclusive +\item{Weight-for-age} age between 60 and 120 months inclusive +\item{BMI-for-age} age between 60 and 228 months inclusive } } \examples{ diff --git a/tests/testthat/test-prevalence.R b/tests/testthat/test-prevalence.R index 85214c2..06a2975 100644 --- a/tests/testthat/test-prevalence.R +++ b/tests/testthat/test-prevalence.R @@ -32,10 +32,10 @@ test_that("strata are considered correctly", { check_with_survey(input, strata = strata) }) -test_that("age only between 61 and 229 is considered", { +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 >= 61 & input$agemons <= 228, ] + input_filtered <- input[input$agemons >= 60 & input$agemons <= 228, ] expect_warning( res1 <- anthroplus_prevalence( input$sex, @@ -88,7 +88,7 @@ test_that("it fails if all values are filtered out", { expect_error( anthroplus_prevalence( 1, - 60, + 59, "n", 100, 35, @@ -212,3 +212,8 @@ test_that("age in months = 228 is part of the age group", { expect_false(is.na(prev_wider_age_groups(228))) expect_false(is.na(prev_age_groups(228))) }) + +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))) +}) diff --git a/tests/testthat/test-zscores.R b/tests/testthat/test-zscores.R index dc27bfd..1f4266f 100644 --- a/tests/testthat/test-zscores.R +++ b/tests/testthat/test-zscores.R @@ -24,6 +24,21 @@ test_that("zscore references match from previous implementation", { expect_equal(result$age_in_months, data$agemons) }) +test_that("computes correct value for age ~ 60 months", { + 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) + ) + expect_equal(res$zwfa, c(0.21, 0.79)) + expect_equal(res$fwfa, c(0, 0)) + expect_equal(res$zbfa, c(-0.58, 0.42)) + expect_equal(res$fbfa, c(0, 0)) + expect_equal(res$zhfa, c(0.96, 0.85)) + 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), @@ -104,7 +119,7 @@ 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 inclusive", { res <- anthroplus_zscores( 1, c(120, 228, 120.1, 228.1), height_in_cm = 60, @@ -114,3 +129,28 @@ test_that("Age upper bounds are inclusive", { expect_equal(is.na(res$zwfa), c(FALSE, TRUE, TRUE, TRUE)) expect_equal(is.na(res$zbfa), c(FALSE, FALSE, FALSE, TRUE)) }) + +test_that("age >= 60 months is supported", { + res <- anthroplus_zscores( + 1, 60, + height_in_cm = 60, + weight_in_kg = 30 + ) + expect_false(is.na(res$zhfa)) + expect_false(is.na(res$zwfa)) + expect_false(is.na(res$zbfa)) +}) + +test_that("age < 60 months results in all NA scores and flags", { + res <- anthroplus_zscores( + 1, 59, + height_in_cm = 60, + weight_in_kg = 30 + ) + expect_true(is.na(res$zhfa)) + expect_true(is.na(res$zwfa)) + expect_true(is.na(res$zbfa)) + expect_true(is.na(res$fhfa)) + expect_true(is.na(res$fwfa)) + expect_true(is.na(res$fbfa)) +})