Add function to create datapack download standalone

mrc-ide · Dec 6, 2024 · af71bd1 · af71bd1
1 parent c71c907
commit af71bd1
Show file tree

Hide file tree

Showing 8 changed files with 174 additions and 16 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: naomi
 Title: Naomi Model for Subnational HIV Estimates
-Version: 2.10.4
+Version: 2.10.5
 Authors@R:
     person(given = "Jeff",
            family = "Eaton",

diff --git a/NEWS.md b/NEWS.md
@@ -1,3 +1,7 @@
+# naomi 2.10.5
+
+* Add standalone datapack download so that users do not have to download zip and extract this manually.
+
 # naomi 2.10.4
 
 * If users upload multiple quarters in ART programme data, return only the last quarter per year for input comparison data.

diff --git a/R/downloads.R b/R/downloads.R
@@ -130,6 +130,34 @@ hintr_prepare_agyw_download <- function(output, pjnz,
   )
 }
 
+#' Prepare Datapack download
+#'
+#' @param output hintr output object
+#' @param path Path to save output file
+#' @param vmmc_file Optional file object, with path, filename and hash for
+#'   VMMC input
+#'
+#' @return Path to output file and metadata for file
+#' @export
+hintr_prepare_datapack_download <- function(output,
+                                            path = tempfile(fileext = ".csv"),
+                                            vmmc_file = NULL) {
+  assert_model_output_version(output)
+  progress <- new_simple_progress()
+  progress$update_progress("PROGRESS_DOWNLOAD_SPECTRUM")
+  model_output <- read_hintr_output(output$model_output_path)
+  options <- yaml::read_yaml(text = model_output$info$options.yml)
+  list(
+    path = save_output_datapack(path, model_output$output_package,
+                                vmmc_file$path),
+    metadata = list(
+      description = build_datapack_description(options),
+      areas = options$area_scope,
+      type = "datapack"
+    )
+  )
+}
+
 build_output_description <- function(options) {
   build_description(t_("DOWNLOAD_OUTPUT_DESCRIPTION"), options)
 }
@@ -146,6 +174,10 @@ build_agyw_tool_description <- function(options) {
   build_description(t_("DOWNLOAD_AGYW_DESCRIPTION"), options)
 }
 
+build_datapack_description <- function(options) {
+  build_description(t_("DOWNLOAD_DATAPACK_DESCRIPTION"), options)
+}
+
 build_description <- function(type_text, options) {
   write_options <- function(name, value) {
     sprintf("%s - %s", name, value)

diff --git a/R/outputs.R b/R/outputs.R
@@ -193,7 +193,7 @@ extract_indicators <- function(naomi_fit, naomi_mf, na.rm = FALSE) {
                          "anc_tested_neg_t4_out" = "anc_tested_neg",
                          "anc_rho_t4_out" = "anc_prevalence",
                          "anc_alpha_t4_out" = "anc_art_coverage")
-  
+
 
   indicator_anc_est_t1 <- Map(get_est, names(indicators_anc_t1), indicators_anc_t1,
                               naomi_mf$calendar_quarter1, list(naomi_mf$mf_anc_out))
@@ -886,6 +886,23 @@ save_output_spectrum <- function(path, naomi_output, notes = NULL,
               export_datapack = TRUE)
 }
 
+save_output_datapack <- function(path, naomi_output, vmmc_path = NULL) {
+  if (!is.null(vmmc_path)) {
+    ## Skip the first row, the file has two rows of headers
+    vmmc_datapack_raw <- openxlsx::read.xlsx(vmmc_path, sheet = "Datapack inputs",
+                                             startRow = 2)
+    vmmc_datapack <- transform_dmppt2(vmmc_datapack_raw)
+  } else {
+    vmmc_datapack <- NULL
+  }
+
+  write_datapack_csv(naomi_output = naomi_output,
+                     path = path,
+                     psnu_level = naomi_output$fit$model_options$psnu_level,
+                     dmppt2_output = vmmc_datapack)
+}
+
+
 #' Save outputs to zip file
 #'
 #' @param naomi_output Naomi output object
@@ -994,20 +1011,8 @@ save_output <- function(filename, dir,
   }
 
   if (export_datapack) {
-
-    if (!is.null(vmmc_path)) {
-      ## Skip the first row, the file has two rows of headers
-      vmmc_datapack_raw <- openxlsx::read.xlsx(vmmc_path, sheet = "Datapack inputs",
-                                               startRow = 2)
-      vmmc_datapack <- transform_dmppt2(vmmc_datapack_raw)
-    } else {
-      vmmc_datapack <- NULL
-    }
-
-    write_datapack_csv(naomi_output = naomi_output,
-                       path = PEPFAR_DATAPACK_FILENAME,   # global defined in R/pepfar-datapack.R
-                       psnu_level = naomi_output$fit$model_options$psnu_level,
-                       dmppt2_output = vmmc_datapack)
+    # PEPFAR_DATAPACK_FILENAME global defined in R/pepfar-datapack.R
+    save_output_datapack(PEPFAR_DATAPACK_FILENAME, naomi_output, vmmc_path)
   }
 
 

diff --git a/inst/traduire/en-translation.json b/inst/traduire/en-translation.json
@@ -274,6 +274,7 @@
     "DOWNLOAD_SUMMARY_DESCRIPTION": "Naomi summary report uploaded from Naomi web app",
     "DOWNLOAD_COMPARISON_DESCRIPTION": "Naomi comparison report uploaded from Naomi web app",
     "DOWNLOAD_AGYW_DESCRIPTION": "Naomi AGYW tool uploaded from Naomi web app",
+    "DOWNLOAD_DATAPACK_DESCRIPTION": "Naomi datapack output uploaded from Naomi web app",
     "NUMBER_ON_ART": "Number on ART",
     "NUMBER_ON_ART_DESC": "Number on ART description",
     "POPULATION_PROPORTION": "Population proportion",

diff --git a/inst/traduire/fr-translation.json b/inst/traduire/fr-translation.json
@@ -271,6 +271,7 @@
     "DOWNLOAD_OUTPUT_DESCRIPTION": "Paquet Naomi téléchargée depuis l'application web Naomi",
     "DOWNLOAD_SUMMARY_DESCRIPTION": "Rapport de synthèse Naomi téléchargé depuis l'application web Naomi",
     "DOWNLOAD_COMPARISON_DESCRIPTION": "Rapport de comparaison Naomi téléchargé à partir de l'application web Naomi",
+    "DOWNLOAD_DATAPACK_DESCRIPTION": "Sortie du datapack Naomi téléchargée depuis l'application web Naomi",
     "NUMBER_ON_ART": "Nombre de personnes sous TARV",
     "NUMBER_ON_ART_DESC": "Number on ART description",
     "POPULATION_PROPORTION": "Proportion de la population",

diff --git a/inst/traduire/pt-translation.json b/inst/traduire/pt-translation.json
@@ -271,6 +271,7 @@
     "DOWNLOAD_OUTPUT_DESCRIPTION": "Pacote Naomi descarregado a partir da aplicação web Naomi",
     "DOWNLOAD_SUMMARY_DESCRIPTION": "Relatório de síntese da Naomi carregado da aplicação web Naomi",
     "DOWNLOAD_COMPARISON_DESCRIPTION": "Relatório de comparação Naomi carregado a partir da aplicação web Naomi",
+    "DOWNLOAD_DATAPACK_DESCRIPTION": "Saída do Naomi datapack carregada a partir da aplicação web Naomi",
     "NUMBER_ON_ART": "Nombre de personnes sous TARV",
     "NUMBER_ON_ART_DESC": "Number on ART description",
     "POPULATION_PROPORTION": "Proporção da população",

diff --git a/tests/testthat/test-downloads.R b/tests/testthat/test-downloads.R
@@ -227,3 +227,117 @@ test_that("output description is translated", {
   expect_match(text, paste0("Paquet Naomi téléchargée depuis l'application ",
                             "web Naomi\\n\\nPérimètre de zone - MWI\\n.+"))
 })
+
+test_that("spectrum download can be created", {
+  mock_new_simple_progress <- mockery::mock(MockSimpleProgress$new())
+  notes <- "these are my\nmultiline notes"
+  with_mock(new_simple_progress = mock_new_simple_progress, {
+    messages <- naomi_evaluate_promise(
+      out <- hintr_prepare_spectrum_download(a_hintr_output_calibrated,
+                                             notes = notes))
+  })
+  expect_true(file.exists(out$path))
+
+  expect_type(out$metadata$description, "character")
+  expect_length(out$metadata$description, 1)
+  expect_equal(out$metadata$areas, "MWI")
+
+  tmp <- tempfile()
+  info <- naomi_info(format_data_input(a_hintr_data), a_hintr_options)
+  info_names <- paste0("info/", names(info))
+  unzip(out$path, exdir = tmp, files = info_names)
+  expect_equal(dir(tmp), "info")
+  expect_equal(dir(file.path(tmp, "info")), names(info))
+
+
+  ## # UNAIDS Navigator Checklist checks
+  navigator_checklist <- utils::read.csv(unz(out$path, "info/unaids_navigator_checklist.csv"))
+
+
+  expect_equal(names(navigator_checklist),
+               c("NaomiCheckPermPrimKey", "NaomiCheckDes", "TrueFalse"))
+
+  checklist_primkeys <- c( "ART_is_Spectrum","ANC_is_Spectrum","Package_created",
+                           "Package_has_all_data","Opt_recent_qtr","Opt_future_proj_qtr",
+                           "Opt_area_ID_selected","Opt_calendar_survey_match","Opt_recent_survey_only",
+                           "Opt_ART_coverage","Opt_ANC_data","Opt_ART_data",
+                           "Opt_ART_attendance_yes","Model_fit","Cal_Population",
+                           "Cal_PLHIV","Cal_ART","Cal_KOS",
+                           "Cal_new_infections","Cal_method" )
+  expect_equal(navigator_checklist$NaomiCheckPermPrimKey, checklist_primkeys)
+  expect_true(all(navigator_checklist$TrueFalse %in% c(TRUE, FALSE)))
+  ## Check tradiure translation hooks worked
+  expect_true("Calibration - method is logistic" %in% navigator_checklist$NaomiCheckDes)
+
+
+  outputs <- read_output_package(out$path)
+  expect_true(
+    all(c("area_level", "area_level_label", "area_id", "area_name", "parent_area_id",
+          "spectrum_region_code", "area_sort_order", "geometry") %in%
+          names(outputs$meta_area))
+  )
+
+  tmpf <- tempfile()
+  unzip(out$path, "boundaries.geojson", exdir = tmpf)
+  output_boundaries <- sf::read_sf(file.path(tmpf, "boundaries.geojson"))
+
+  ## Column 'name' added in boundaries.geojson during save_output() for Spectrum
+  expect_true(
+    all(c("area_level", "area_level_label", "area_id", "area_name", "parent_area_id",
+          "spectrum_region_code", "area_sort_order", "name", "geometry") %in%
+          names(output_boundaries))
+  )
+
+  ## Progress messages printed
+  expect_length(messages$progress, 1)
+  expect_equal(messages$progress[[1]]$message,
+               "Generating output zip download")
+
+  ## Notes are saved
+  t <- tempfile()
+  unzip(out$path, "notes.txt", exdir = t)
+  saved_notes <- readLines(file.path(t, "notes.txt"))
+  expect_equal(saved_notes, c("these are my", "multiline notes"))
+})
+
+test_that("datapack download can be created", {
+  mock_new_simple_progress <- mockery::mock(MockSimpleProgress$new())
+  with_mock(new_simple_progress = mock_new_simple_progress, {
+    messages <- naomi_evaluate_promise(
+      out <- hintr_prepare_datapack_download(a_hintr_output_calibrated))
+  })
+  expect_true(file.exists(out$path))
+
+  expect_type(out$metadata$description, "character")
+  expect_length(out$metadata$description, 1)
+  expect_equal(out$metadata$areas, "MWI")
+
+  datapack <- utils::read.csv(out$path)
+
+  expect_true("psnu_uid" %in% colnames(datapack))
+  expect_true(!any(is.na(datapack)))
+  ## Simple smoke test that we have some indicator code
+  expect_true("HIV_PREV.T_1" %in% datapack$indicator_code)
+})
+
+test_that("datapack download can include vmmc data", {
+  mock_new_simple_progress <- mockery::mock(MockSimpleProgress$new())
+  vmmc_file <- list(path = file.path("testdata", "vmmc.xlsx"),
+                    hash = "123",
+                    filename = "vmmc.xlsx")
+  testthat::with_mocked_bindings(
+    messages <- naomi_evaluate_promise(
+      out <- hintr_prepare_datapack_download(a_hintr_output_calibrated,
+                                             vmmc_file = vmmc_file)
+    ),
+    new_simple_progress = mock_new_simple_progress
+  )
+  expect_true(file.exists(out$path))
+
+  datapack <- utils::read.csv(out$path)
+
+  expect_true("psnu_uid" %in% colnames(datapack))
+  expect_true(!any(is.na(datapack)))
+  expect_true(all(c("VMMC_CIRC_SUBNAT.T_1", "VMMC_TOTALCIRC_SUBNAT.T_1") %in%
+                    datapack$indicator_code))
+})