SHIPP tool integration

.gitignore

@@ -21,3 +21,5 @@ tests/testthat/testdata/fit.RDS
 .vscode
 .Rprofile
 .idea
+
+.DS_Store

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: naomi
 Title: Naomi Model for Subnational HIV Estimates
-Version: 2.9.23
+Version: 2.9.24
 Authors@R:
     person(given = "Jeff",
            family = "Eaton",
@@ -36,6 +36,7 @@ Imports:
     knitr,
     magrittr,
     mvtnorm,
+    naomi.resources (>= 0.0.3),
     naomi.options (>= 1.2.0),
     openxlsx,
     plotly,
@@ -51,7 +52,6 @@ Imports:
     traduire,
     utils,
     withr,
-    writexl,
     yaml,
     zip,
     zoo
@@ -78,8 +78,9 @@ Remotes:
     first90=mrc-ide/first90release,
     reside-ic/traduire,
     mrc-ide/naomi.options,
+    mrc-ide/naomi.resources,
     mrc-ide/mockr,
     mrc-ide/testthat.buildkite,
-    duckdb/[email protected]
+    duckdb=duckdb/[email protected]
 Config/testthat/edition: 3
 Config/testthat/parallel: true

NAMESPACE

@@ -44,9 +44,9 @@ export(get_plotting_metadata)
 export(hintr_calibrate)
 export(hintr_calibrate_plot)
 export(hintr_comparison_plot)
-export(hintr_prepare_agyw_download)
 export(hintr_prepare_coarse_age_group_download)
 export(hintr_prepare_comparison_report_download)
+export(hintr_prepare_shipp_download)
 export(hintr_prepare_spectrum_download)
 export(hintr_prepare_summary_report_download)
 export(hintr_run_model)

NEWS.md

@@ -1,3 +1,8 @@
+# naomi 2.9.24
+
+* Generate PSE workbook from naomi outputs.
+* Add function `extract_kp_workbook()` to extract key population totals from the Spectrum PJNZ file. Data are extracted from summary table saved in AIM Programme Statistics input for key populations.
+
 # naomi 2.9.23
 
 * Update Datim UIDs for Ethiopia 2024 boundary division.

R/downloads.R

@@ -101,31 +101,39 @@ hintr_prepare_comparison_report_download <- function(output,
   )
 }
 
-#' Prepare AGYW tool download
+#' Prepare SHIPP tool download
 #'
 #' @param hintr_output object
 #' @param path Path to save output file
 #' @param pjnz Path to input PJNZ file
 #'
 #' @return Path to output file and metadata for file
 #' @export
-hintr_prepare_agyw_download <- function(output, pjnz,
+hintr_prepare_shipp_download <- function(output, pjnz,
                                         path = tempfile(fileext = ".xlsx")) {
   ## TODO: Do we need a version restriction on this?
   assert_model_output_version(output, "2.7.16")
   progress <- new_simple_progress()
-  progress$update_progress("PROGRESS_DOWNLOAD_AGYW")
-  dummy_data <- data.frame(x = c(1, 2, 3), y = c(3, 4, 5))
-  writexl::write_xlsx(list(sheet = dummy_data), path = path)
+  progress$update_progress("PROGRESS_DOWNLOAD_SHIPP")
+
+  risk_populations <- shipp_generate_risk_populations(output$model_output_path,
+                                                     pjnz)
+
+  sheets <- list(
+    "All outputs - F" = risk_populations$female_incidence,
+    "All outputs - M" = risk_populations$male_incidence,
+    "NAOMI outputs" = risk_populations$naomi_output
+  )
+  write_shipp_workbook(sheets, dest = path)
 
   model_output <- read_hintr_output(output$model_output_path)
   options <- yaml::read_yaml(text = model_output$info$options.yml)
   list(
     path = path,
     metadata = list(
-      description = build_agyw_tool_description(options),
+      description = build_shipp_tool_description(options),
       areas = options$area_scope,
-      type = "agyw"
+      type = "shipp"
     )
   )
 }
@@ -142,8 +150,8 @@ build_comparison_report_description <- function(options) {
   build_description(t_("DOWNLOAD_COMPARISON_DESCRIPTION"), options)
 }
 
-build_agyw_tool_description <- function(options) {
-  build_description(t_("DOWNLOAD_AGYW_DESCRIPTION"), options)
+build_shipp_tool_description <- function(options) {
+  build_description(t_("DOWNLOAD_SHIPP_DESCRIPTION"), options)
 }
 
 build_description <- function(type_text, options) {

R/inputs-spectrum.R

@@ -127,6 +127,8 @@ extract_pjnz_one <- function(pjnz, extract_shiny90) {
 #' @export
 #'
 extract_pjnz_program_data <- function(pjnz_list) {
+
+
   pjnz_list <- unroll_pjnz(pjnz_list)
 
   region_code <- lapply(pjnz_list, read_spectrum_region_code)
@@ -185,7 +187,7 @@ read_dp_art_dec31 <- function(dp) {
 
   ## In Spectrum 2023, "<NeedARTDec31 MV>" was updated to include children in the totals
   ## -> now need to sum over 5-year age groups for age 15+ to get the adult ART need
-  
+
   male_15plus_needart <- dpsub("<NeedARTDec31 MV>", 4:17*3 + 3, timedat.idx)
   male_15plus_needart <- vapply(lapply(male_15plus_needart, as.numeric), sum, numeric(1))
 
@@ -195,14 +197,14 @@ read_dp_art_dec31 <- function(dp) {
   art15plus_need <- rbind(male_15plus_needart, female_15plus_needart)
   dimnames(art15plus_need) <- list(sex = c("male", "female"), year = proj.years)
 
-  
+
   if (any(art15plus_num[art15plus_isperc == 1] < 0 |
           art15plus_num[art15plus_isperc == 1] > 100)) {
     stop("Invalid percentage on ART entered for adult ART")
   }
 
   ## # Adult on ART adjustment factor
-  ## 
+  ##
   ## * Implemented from around Spectrum 6.2 (a few versions before)
   ## * Allows user to specify scalar to reduce number on ART in each year ("<AdultARTAdjFactor>")
   ## * Enabled / disabled by checkbox flag ("<AdultARTAdjFactorFlag>")
@@ -281,7 +283,7 @@ read_dp_art_dec31 <- function(dp) {
   names(child_art) <- proj.years
 
   ## # Child on ART adjustment factor
-  ## 
+  ##
   ## * Implemented same as adult adjustment factor above
 
   if (exists_dptag("<ChildARTAdjFactorFlag>") &&
@@ -684,7 +686,111 @@ extract_eppasm_pregprev <- function(mod, fp, years = NULL) {
   df
 }
 
+
+
 read_dp <- function(pjnz) {
   dpfile <- grep(".DP$", utils::unzip(pjnz, list = TRUE)$Name, value = TRUE)
   utils::read.csv(unz(pjnz, dpfile), as.is = TRUE)
 }
+
+#' Read key population summary data from PJNZ
+#'
+#' Reads key population summary data from Spectrum PJNZ.
+#'
+#' @param pjnz_list path to PJNZ file or zip of multiple PJNZ files
+#'
+#'
+#' @noRd
+#'
+
+extract_kp_workbook <- function(pjnz_list){
+
+  # Extract spectrum files
+  pjnz_list <- unroll_pjnz(pjnz_list)
+
+  # Extract .DP files
+  dp <- lapply(pjnz_list, read_dp)
+
+  # Extract kp workbook summary
+  kp <- lapply(dp, read_dp_keypop_summary)
+
+  # Filter for spectrum file with consensus estimates
+  kp_out <- kp %>%
+    dplyr::bind_rows() %>%
+    dplyr::filter(!is.na(year))
+
+  # If no consensus estimates present, return empty dataframe
+  if(nrow(kp_out) == 0){kp_out <- kp[[1]]}
+
+  # If multiple pjnz files, aggreagte consensus estimates
+  if(nrow(kp_out) > 4){
+
+    kp_out <- kp_out |>
+      dplyr::group_by(key_population, year, workbook_file) |>
+      dplyr::summarise(population_size = sum(population_size),
+                hiv_prevalence = sum(hiv_prevalence),
+                art_coverage = sum(art_coverage),
+                infections = sum(infections))
+
+  }
+
+  kp_out
+
+}
+
+
+#' Read key population summary data from PJNZ
+#'
+#' Reads key population summary data from Spectrum PJNZ.
+#'
+#' @param pjnz path to PJNZ file
+#'
+#' @examples
+#' pjnz <- system.file("extdata/demo_mwi2019.PJNZ", package = "naomi")
+#' dp <- dp <- naomi:::read_dp(pjnz)
+#' read_dp_keypop_summary(dp)
+#'
+#' @noRd
+#'
+read_dp_keypop_summary <- function(dp) {
+
+  exists_dptag <- function(tag, tagcol = 1) {
+    tag %in% dp[, tagcol]
+  }
+  dpsub <- function(tag, rows, cols, tagcol = 1) {
+    dp[which(dp[, tagcol] == tag) + rows, cols]
+  }
+
+  kp_name <- c("FSW", "MSM", "TG", "PWID")
+
+  if (exists_dptag("<KeyPops MV>")) {
+    kp_tab <- dpsub("<KeyPops MV>", 2:5, 4:7)
+    kp_tab <- sapply(kp_tab, as.numeric)
+  } else {
+    kp_tab <- matrix(NA, 4, 4)
+  }
+
+  if (exists_dptag("<KeyPopsYear MV>")) {
+    kp_year <- as.integer(dpsub("<KeyPopsYear MV>", 2, 4))
+  } else {
+    kp_year <- NA_integer_
+  }
+
+    if (exists_dptag("<KeyPopsFName MV>")) {
+    kp_file <- as.character(dpsub("<KeyPopsFName MV>", 2, 4))
+  } else {
+    kp_file <- NA_character_
+  }
+
+  kp_summary <- data.frame(
+    key_population = kp_name,
+    year = kp_year,
+    population_size = kp_tab[1, ],
+    hiv_prevalence = kp_tab[2, ],
+    art_coverage = kp_tab[3, ],
+    infections = kp_tab[4, ],
+    workbook_file = kp_file
+  )
+
+  kp_summary
+}