Merge pull request #448 from mrc-ide/update-test-data

Update test data with 2024 Spectrum file, survey, and programme data

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: naomi
 Title: Naomi Model for Subnational HIV Estimates
-Version: 2.9.29
+Version: 2.10.0
 Authors@R:
     person(given = "Jeff",
            family = "Eaton",

NEWS.md

@@ -1,3 +1,21 @@
+# naomi 2.10.0
+
+* Update Naomi example and test datasets to current example data for Malawi
+  - Population dataset extended from 2025 to 2030
+  - Imported final Malawi Spectrum file for 2024 UNAIDS estimates `extdata/demo_mwi2024_v6.36.PJNZ`.
+    File created with Spectrum v6.36.  
+  - Example ART and ANC programme data by district from Malawi updated through 2023 Q4
+  - Added MPHIA 2020-21 survey to example survey data.
+  - Created new example Northern / Central / Southern region Spectrum files for testing
+    and demonstration of subnational Spectrum PJNZ files.
+	- In each of these files, updated the surveillance data, refit EPP, and refit Shiny90.
+	  See the `data-raw/demo-subnational-pjnz/README.md` for more details
+	  
+  - Update vignettes with new datasets and default options.
+
+* Update Navigator checklist calendar quarter for 2025 estimates to
+  2024Q4 and 2025Q3 for current period and projection.
+
 # naomi 2.9.29
 
 * Add function to format data for Naomi-Spectrum comparison table.

data-raw/demo-subnational-pjnz/README.md

@@ -1,4 +1,8 @@
-These files are alternative testing and demonstration files representing subnational Spectrum files. Three Spectrum PJNZ files werecreated based on the Malawi 2019 PJNZ file.
+These files are alternative testing and demonstration files representing subnational 
+Spectrum files. Three Spectrum PJNZ files werecreated based on the Malawi 2019 PJNZ file.
+
+_Update 22 August 2024:_ Updated files were created with the Malawi 2024 PJNZ file
+using Sepctrum 6.36. Saved in folder `mwi2024_v6.36/`.
 
 Region codes in .PJN files manually changed as follows:
 
@@ -26,6 +30,7 @@ The base population and net migration were scaled in each file based on the prop
 
 No other changes were made to demographic inputs. Fertility and non-HIV mortality rates were retained at national values.
 
+_Update 22 August 2024:_ Same proportion applied for HIV tests conducted in Shiny90.
 
 ### Number on ART
 
@@ -37,7 +42,9 @@ The number on ART was scaled by the proportions:
 | Central  | 29%        |
 | Southern | 61%        |
 
-The same proportions were used for adults on ART, children on ART, and children receiving cotrimoxazole
+The same proportions were used for adults on ART, children on ART, and children receiving cotrimoxazole.
+
+_Update 22 August 2024:_ Same proportion applied for ART initiations and HIV diagnoses in Shiny90.
 
 ### PMTCT and ANC clients
 
@@ -54,4 +61,7 @@ PMTCT and ANC clients were scaled
 
 EPP was refit single region in each file.
 
+_For the 2024 Spectrum file:_ EPP by region was re-imported from the 2022 PJNZ files
+
 Analysis was done using the Spectrum v5.87 and based from the 2019 Malawi Spectrum file.
+

data-raw/demo-subnational-pjnz/mwi2024_v6.36/shrink-and-zip.R

@@ -0,0 +1,37 @@
+
+raw <- c("demo_mwi2024_central.pjnz",
+         "demo_mwi2024_northern.pjnz", 
+         "demo_mwi2024_southern.pjnz")
+
+write_pjn_region_name <- function(pjnz, new_region_name) {
+  pjn_file <- grep("PJN$", unzip(pjnz, list = TRUE)$Name, ignore.case = TRUE, value = TRUE)
+  pjn <- readLines(unz(pjnz, pjn_file))
+  reg_tag_line <- grep("^<Projection Parameters - Subnational Region Name2>", pjn)
+
+  ## Note: This will not work correctly if there is an existing region name
+  pjn[reg_tag_line+2] <- sub("^,,,", paste0(",,,", new_region_name), pjn[reg_tag_line+2])
+
+  writeLines(pjn, pjn_file)
+  zip(pjnz, pjn_file)
+  file.remove(pjn_file)
+  naomi::read_spectrum_region_name(pjnz)
+}
+
+write_pjn_region_name("demo_mwi2024_central.pjnz", "Central Region")
+write_pjn_region_name("demo_mwi2024_northern.pjnz", "Northern Region")
+write_pjn_region_name("demo_mwi2024_southern.pjnz", "Southern Region")
+
+new <- sub(".pjnz", "_small.pjnz", raw)
+file.copy(raw, new)
+
+library(zip)
+
+lapply(new,
+       \(x) {
+         f <- zip_list(x)$filename
+         f_delete <- grep("DP$|PJN$|shiny90$", f, value = TRUE, invert = TRUE)
+         utils::zip(x, f_delete, flags="-d")
+       })
+
+zip("demo_mwi2024_region-pjnz.zip", new)
+

data-raw/demo-subnational-pjnz/region-distribution.R

@@ -17,30 +17,30 @@ pop_reg <- df %>%
   count(calendar_quarter, area_id1, area_name1, wt = population, name = "population") %>%
   group_by(calendar_quarter) %>%
   mutate(prop = population / sum(population)) %>%
-  pivot_wider(calendar_quarter, names_from = area_name1, values_from = prop)
+  pivot_wider(id_cols = calendar_quarter, names_from = area_name1, values_from = prop)
 
 art_number %>%
   left_join(st_drop_geometry(areas_wide)) %>%
   count(calendar_quarter, area_id1, area_name1, wt = art_current, name = "art_current") %>%
   group_by(calendar_quarter) %>%
   mutate(prop = art_current / sum(art_current)) %>%
-  pivot_wider(calendar_quarter, names_from = area_name1, values_from = prop)
+  pivot_wider(id_cols = calendar_quarter, names_from = area_name1, values_from = prop)
 
 anc_testing %>%
   left_join(st_drop_geometry(areas_wide)) %>%
   group_by(year, area_id1, area_name1) %>%
   summarise(across(starts_with("anc"), sum)) %>%
   group_by(year) %>%
   mutate(prop = anc_clients / sum(anc_clients)) %>%
-  pivot_wider(year, names_from = area_name1, values_from = prop)
+  pivot_wider(id_cols = year, names_from = area_name1, values_from = prop)
 
 anc_testing %>%
   left_join(st_drop_geometry(areas_wide)) %>%
   group_by(year, area_id1, area_name1) %>%
   summarise(across(starts_with("anc"), sum)) %>%
   group_by(year) %>%
   mutate(prop = anc_known_pos / sum(anc_known_pos)) %>%
-  pivot_wider(year, names_from = area_name1, values_from = prop)
+  pivot_wider(id_cols = year, names_from = area_name1, values_from = prop)
 
 anc_testing %>%
   left_join(st_drop_geometry(areas_wide)) %>%
@@ -91,7 +91,7 @@ anc_testing_zone <- anc_testing %>%
     by = "area_id"
   ) %>%
   group_by(area_id = area_id2, area_name = area_name2, age_group, year) %>%
-  summarise(across(starts_with("anc"), sum), .groups = "drop")
+  summarise(across(c(starts_with("anc"), "births_facility"), sum), .groups = "drop")
 
 
 art_number_zone <- art_number %>%

data-raw/pjnz.R

@@ -1,9 +1,14 @@
-#' This script adds the Malawi 2019 Spectrum PJNZ file for testing and demonstration purposes.
-#' Files are taken from UNAIDS estimates files produced by national HIV estimates teams for UNAIDS.
+#' This script adds the Malawi 2019 and 2024 Spectrum PJNZ file for testing and
+#' demonstration purposes.
 #'
-#' To access data and estimates for these and other countries, please visit http://aidsinfo.unaids.org/
-#' or http://www.unaids.org/en/dataanalysis/datatools/spectrum-epp to request the most recent Spectrum
-#' estimates files.
+#' Files are taken from UNAIDS estimates files produced by national HIV estimates
+#' teams for UNAIDS.
+#'
+#' To access data and estimates for these and other countries, please visit
+#' http://aidsinfo.unaids.org/
+#' or http://www.unaids.org/en/dataanalysis/datatools/spectrum-epp to request
+#' the most recent Spectrum estimates files.
+#' 
 
 library(here)
 library(zip)
@@ -37,3 +42,19 @@ zip_list(shiny90tmp)
 
 zip_append(path, shiny90tmp, mode = "cherry-pick")
 zip_list(path)
+
+
+#' ## Add 2024 Spectrum PJNZ file
+
+raw24 <- "~/Data/Spectrum files/2024 final shared/Public spectrum files/ESA/Malawi_2024_v11_ART_Num.pjnz"
+path24 <- here("inst/extdata/demo_mwi2024.PJNZ")
+
+file.copy(raw24, path24)
+zip_list(path24)
+
+## Remove files to reduce size
+## Keep only .PJN, .DP, and .shiny90 file
+
+utils::zip(path24, grep("DP$|PJN$|shiny90$", zip_list(path24)$filename, value = TRUE, invert = TRUE), flags="-d")
+
+zip_list(path24)

data-raw/population.R

@@ -57,7 +57,7 @@ a5 <- Map(readxl::read_excel,
 
 a5aggr <- a5 %>%
   filter(age != "Total") %>%
-  mutate(age = sub("\\+", "", age) %>% utils::type.convert,
+  mutate(age = sub("\\+", "", age) %>% utils::type.convert(as.is = TRUE),
          age_group = cut(age, c(0, 1, 1:18*5, Inf),
                          c("Less than 1 Year", "1-4", paste0(1:17*5, "-", 2:18*5 - 1), "90+"),
                          TRUE, FALSE)) %>%
@@ -93,7 +93,8 @@ cens18 <- spread_areas(demo_area_hierarchy) %>%
     filter(area_level == 4) %>%
     select(area_id, sex, pop_a3)
    ,
-    by = c("area_id4" = "area_id")
+    by = c("area_id4" = "area_id"),
+    relationship = "many-to-many"
   ) %>%
   left_join(
     a5aggr %>%
@@ -209,7 +210,7 @@ cens18adj %>%
 
 
 population_agesex <- nso %>%
-  filter(year %in% 2008:2025) %>%
+  filter(year %in% 2008:2030) %>%
   left_join(cens18adj) %>%
   mutate(
     source = "Census 2018",

data-raw/programme.R

@@ -35,12 +35,14 @@ data(demo_area_hierarchy)
 #'
 #' Written approval for inclusion in naomi R package provided by Thoko Kalua via email
 #' on 4 September 2019.
+#'
+#' Dataset updated through Q4 2023 on 16 November 2024.
 
 demo_anc_testing <- read_csv(here("data-raw/programme/mwi_dha_ancrt.csv"))
 
 demo_anc_testing <- demo_anc_testing %>%
   rename(area_name = district32) %>%
-  filter(year <= 2017 | year == 2018 & quarter %in% 1:3) %>%
+  filter(year <= 2023) %>%
   left_join(
     demo_area_hierarchy %>%
     filter(area_level == 4) %>%