create example dataset terminating with 28 district (level 3)

saved in extdata/demo-district28/

NEWS.md

@@ -1,3 +1,8 @@
+# naomi 2.10.9
+
+* Add example datasets for 28 district, dropping the `District + Metro` level.
+  Datasets are saved in `extdata/demo-district28`.
+
 # naomi 2.10.6
 
 * Update `read_dp_art_dec31()` with new .DP file flags to ensure ART adjustment factor and ART patient reallocation counts are applied to number on ART extracted from Spectrum.

data-raw/demo-district28/README.md

@@ -0,0 +1,3 @@
+# District-level example datasets
+
+Create version of example datasets using 28 districts (area_level = 3) to avoid confusion about `District + Metro` level.

data-raw/demo-district28/district28-demo-data.R

@@ -0,0 +1,72 @@
+library(naomi)
+library(tidyverse)
+library(sf)
+
+area_merged <- read_sf(system.file("extdata/demo_areas.geojson", package = "naomi"))
+
+pop_agesex <- read_csv(system.file("extdata/demo_population_agesex.csv", package = "naomi"))
+art_number <- read_csv(system.file("extdata/demo_art_number.csv", package = "naomi"))
+anc_testing <- read_csv(system.file("extdata/demo_anc_testing.csv", package = "naomi"))
+survey <- read_csv(system.file("extdata/demo_survey_hiv_indicators.csv", package = "naomi"))
+
+areas_wide <- spread_areas(area_merged)
+
+
+extdata_path <- "../../inst/extdata/demo-district28"
+dir.create(extdata_path)
+
+#' Update areas for spectrum region code
+
+areas_district28 <- area_merged %>%
+  filter(area_level %in% 0:3)
+
+write_sf(areas_district28, file.path(extdata_path, "demo_areas_district28.geojson"))
+
+
+#' Create zone-level versions of ANC testing, ART, and population datasets
+#'
+
+anc_testing_district28 <- anc_testing %>%
+  inner_join(
+    areas_wide %>%
+    st_drop_geometry() %>%
+    select(area_id, area_id3, area_name3),
+    by = "area_id"
+  ) %>%
+  group_by(area_id = area_id3, area_name = area_name3, age_group, year) %>%
+  summarise(across(c(starts_with("anc"), "births_facility"), sum), .groups = "drop")
+
+art_number_district28 <- art_number %>%
+  inner_join(
+    areas_wide %>%
+    st_drop_geometry() %>%
+    select(area_id, area_id3, area_name3),
+    by = "area_id"
+  ) %>%
+  group_by(area_id = area_id3, area_name = area_name3, sex, age_group, year, calendar_quarter) %>%
+  summarise(across(c(starts_with("art"), starts_with("vl")), sum), .groups = "drop")
+
+population_district28 <- pop_agesex %>%
+  inner_join(
+    areas_wide %>%
+    st_drop_geometry() %>%
+    select(area_id, area_id3, area_name3),
+    by = "area_id"
+  ) %>%
+  group_by(area_id = area_id3, area_name = area_name3, source, calendar_quarter, sex, age_group) %>%
+  summarise(
+    asfr = weighted.mean(asfr, population),
+    population = sum(population),
+    .groups = "drop"
+  ) %>%
+  select(-asfr, everything(), asfr)
+
+
+survey_district28 <- survey %>%
+  semi_join(areas_district28, by = "area_id")
+
+write_csv(anc_testing_district28, file.path(extdata_path, "demo_anc_testing_district28.csv"))
+write_csv(art_number_district28, file.path(extdata_path, "demo_art_number_district28.csv"))
+write_csv(population_district28, file.path(extdata_path, "demo_population_district28.csv"), na = "")
+write_csv(survey_district28, file.path(extdata_path, "demo_survey_district28.csv"), na = "")
+

vignettes_src/hintr-example_district28.R

@@ -0,0 +1,103 @@
+#' ---
+#' title: "Emulate a hintr model run"
+#' output: rmarkdown::html_vignette
+#' vignette: >
+#'   %\VignetteIndexEntry{`hintr` example run}
+#'   %\VignetteEngine{knitr::rmarkdown}
+#'   %\VignetteEncoding{UTF-8}
+#' ---
+
+##+ preamble, include = FALSE
+knitr::opts_chunk$set(
+                    collapse = TRUE,
+                    comment = "#>"
+                  )
+unlink("outputs", recursive = TRUE)
+
+#'
+#'
+#' This vignette provides example
+
+##+ setup, message = FALSE
+
+library(naomi)
+
+##+ fit_model
+hintr_data <- list(
+  pjnz = system.file("extdata/demo_mwi2024_v6.36.PJNZ", package = "naomi"),
+  population = system.file("extdata/demo-district28/demo_population_district28.csv", package = "naomi"),
+  shape = system.file("extdata/demo-district28/demo_areas_district28.geojson", package = "naomi"),
+  survey = system.file("extdata/demo-district28/demo_survey_district28.csv", package = "naomi"),
+  art_number = system.file("extdata/demo-district28/demo_art_number_district28.csv", package = "naomi"),
+  anc_testing = system.file("extdata/demo-district28/demo_anc_testing_district28.csv", package = "naomi")
+)
+
+hintr_options <- list(
+  area_scope = "MWI",
+  area_level = "3",
+  calendar_quarter_t1 = "CY2020Q3",
+  calendar_quarter_t2 = "CY2023Q4",
+  calendar_quarter_t3 = "CY2025Q3",
+  calendar_quarter_t4 = "CY2026Q3",
+  survey_prevalence = "DEMO2020PHIA",
+  survey_art_coverage = "DEMO2020PHIA",
+  survey_recently_infected = "DEMO2020PHIA",
+  include_art_t1 = "true",
+  include_art_t2 = "true",
+  anc_clients_year2 = 2023,
+  anc_clients_year2_num_months = "12",
+  anc_prevalence_year1 = 2020,
+  anc_prevalence_year2 = 2023,
+  anc_art_coverage_year1 = 2020,
+  anc_art_coverage_year2 = 2023,
+  spectrum_population_calibration = "national",
+  artattend = "true",
+  artattend_t2 = "true",
+  artattend_log_gamma_offset = -4L,
+  anchor_home_district = TRUE,
+  output_aware_plhiv = "true",
+  rng_seed = 17,
+  no_of_samples = 500,
+  max_iter = 250,
+  use_kish_prev = "true",
+  deff_prev = 1.0,
+  use_kish_artcov = "true",
+  deff_artcov = 1.0,
+  use_kish_recent = "true",
+  deff_recent = 1.0,
+  use_survey_aggregate = "false",
+  psnu_level = NULL
+)
+
+calibration_options <- list(
+  spectrum_plhiv_calibration_level = "subnational",
+  spectrum_plhiv_calibration_strat = "sex_age_group",
+  spectrum_artnum_calibration_level = "subnational",
+  spectrum_artnum_calibration_strat = "sex_age_group",
+  spectrum_aware_calibration_level = "subnational",
+  spectrum_aware_calibration_strat = "sex_age_group",
+  spectrum_infections_calibration_level = "subnational",
+  spectrum_infections_calibration_strat = "sex_age_group",
+  calibrate_method = "logistic"
+)
+
+hintr_options$outer_verbose <- TRUE
+
+hintr_paths <- hintr_run_model(hintr_data, hintr_options)
+calibrated_paths <- hintr_calibrate(hintr_paths, calibration_options)
+spectrum_download <- hintr_prepare_spectrum_download(calibrated_paths)
+
+coarse_download <- hintr_prepare_coarse_age_group_download(calibrated_paths)
+
+#' TO DO: add summary report download
+
+#' Read output package and generate datapack export
+
+##+ read_output
+naomi_output <- read_output_package(spectrum_download$path)
+
+datapack_path <- tempfile(fileext = ".csv")
+write_datapack_csv(naomi_output, datapack_path)
+
+navigator_path <- tempfile(fileext = ".csv")
+write_navigator_checklist(naomi_output, navigator_path)