diff --git a/DESCRIPTION b/DESCRIPTION index 92dd162c..ddf5d2f8 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: naomi Title: Naomi Model for Subnational HIV Estimates -Version: 2.10.3 +Version: 2.10.4 Authors@R: person(given = "Jeff", family = "Eaton", diff --git a/NEWS.md b/NEWS.md index cfd72066..424d65fb 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,8 @@ +# naomi 2.10.4 + +* If users upload multiple quarters in ART programme data, return only the last quarter per year for input comparison data. + This fixes a bug where previously they were being aggregated. issue-3 24/25 + # naomi 2.10.3 * Return `anc_already_art`, `anc_status`, `anc_art_among_known` and `anc_total_pos` indicators from ANC input time series data. diff --git a/R/input-comparison.R b/R/input-comparison.R index decde903..f073a888 100644 --- a/R/input-comparison.R +++ b/R/input-comparison.R @@ -20,14 +20,23 @@ prepare_art_spectrum_comparison <- function(art, shape, pjnz) { if (!inherits(pjnz, "spec_program_data")) { pjnz <- extract_pjnz_program_data(pjnz) } + ## If user has uploaded multiple calendar quarters within a year, we + ## only want to return 1 value. The last one within the year. + art_single_cq <- art |> + dplyr::mutate(year = calendar_quarter_to_year(calendar_quarter)) |> + dplyr::group_by(area_id, sex, age_group, year) |> + dplyr::mutate(quarter_id = calendar_quarter_to_quarter_id(calendar_quarter)) |> + dplyr::filter(quarter_id == max(quarter_id)) |> + dplyr::ungroup() + ## Aggregate ART data - art_agreggated <- art |> + art_agreggated <- art_single_cq |> dplyr::mutate(year = calendar_quarter_to_year(calendar_quarter)) |> dplyr::left_join(shape, by = "area_id") |> dplyr::count(spectrum_region_code, year, sex, age_group, wt = art_current, name = "value_naomi") - if(identical(unique(art$sex), c("both"))) { + if(identical(unique(art_single_cq$sex), c("both"))) { # If no sex aggregated data present in ART data, aggregate Spectrum by age spec_aggreagted <- pjnz$art_dec31 |> dplyr::count(spectrum_region_code, year, age_group, diff --git a/tests/testthat/test-input-comparison.R b/tests/testthat/test-input-comparison.R index d1620b6a..64571708 100644 --- a/tests/testthat/test-input-comparison.R +++ b/tests/testthat/test-input-comparison.R @@ -99,3 +99,35 @@ test_that("Comparisoon wrapper function works with missing programme data", { expect_equal(nrow(x), 0) }) + +test_that("art data comparison returns value for only last CQ within each year", { + # Create test data with a 2 rows for the same area, sex, and age group + # but with a different calendar quarter. We should be returning the latest + # quarter of these + art <- a_hintr_data$art_number + art_dat <- naomi::read_art_number(art) + art_dat_row <- art_dat[art_dat$area_id == "MWI_2_1_demo" & + art_dat$sex == "both" & + art_dat$age_group == "Y000_014" & + art_dat$calendar_quarter == "CY2011Q4", ] + expected_value <- art_dat_row$art_current + art_dat_row$calendar_quarter <- quarter_id_to_calendar_quarter( + calendar_quarter_to_quarter_id(art_dat_row$calendar_quarter) - 1) + ## We're expecting we don't see this in the aggregated data + art_dat_row$art_current <- 10000 + + art_test <- dplyr::bind_rows(art_dat, art_dat_row) + + # Test that aggregation works with subnational pjnz and sex disaggreagted adults on ART + shape <- a_hintr_data$shape + pjnz <- a_hintr_data$pjnz + + x <- prepare_art_spectrum_comparison(art_test, shape, pjnz) + + modified_row <- x[x$indicator == "number_on_art" & + x$year == "2011" & + x$group == "art_children" & + x$area_name == "Northern", ] + + expect_equal(modified_row$value_naomi, expected_value) +})