From bfb5407873193ca3eed5f009e60a12e5dbc037ba Mon Sep 17 00:00:00 2001 From: Rob Ashton Date: Fri, 6 Dec 2024 08:20:29 +0000 Subject: [PATCH] Add function to create datapack download standalone --- DESCRIPTION | 2 +- NEWS.md | 4 ++ R/downloads.R | 32 +++++++++ R/outputs.R | 35 +++++---- inst/traduire/en-translation.json | 1 + inst/traduire/fr-translation.json | 1 + inst/traduire/pt-translation.json | 1 + tests/testthat/test-downloads.R | 114 ++++++++++++++++++++++++++++++ 8 files changed, 174 insertions(+), 16 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index ddf5d2f8..9c093542 100644 --- 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 index 424d65fb..3a3f3839 100644 --- 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 index 6216af85..848b8390 100644 --- 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 index 8e04f485..8507dd7b 100644 --- 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(naomi_output, vmmc_path, PEPFAR_DATAPACK_FILENAME) } diff --git a/inst/traduire/en-translation.json b/inst/traduire/en-translation.json index 8d65b654..78f07efd 100644 --- 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 index 6d785c48..60c7d9e2 100644 --- 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 index effd3d56..3b5622cb 100644 --- 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 index 7f46686f..17b4f1ff 100644 --- 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)) +})