Fix up testing

hivtools · Jan 10, 2024 · 860229d · 860229d
1 parent cedd4a9
commit 860229d
Show file tree

Hide file tree

Showing 7 changed files with 44 additions and 23 deletions.
diff --git a/R/downloads.R b/R/downloads.R
@@ -27,7 +27,7 @@ download <- function(model_output, type, path_results, input, language = NULL) {
       add_state_json(out$path, input$state)
     }
   } else if (type == "agyw") {
-    out <- naomi::hintr_prepare_agyw_download(model_output, input$pjnz,
+    out <- naomi::hintr_prepare_agyw_download(model_output, input$pjnz$path,
                                               download_path)
   } else {
     func <- switch(type,

diff --git a/R/test_helpers.R b/R/test_helpers.R
@@ -10,7 +10,6 @@
 #' @return JSON built from template and params.
 #' @keywords internal
 #'
-
 build_json <- function(template, params) {
   param_env <- list2env(params, parent = .GlobalEnv)
   glue::glue(template, .envir = param_env, .open = '"<+',
@@ -102,8 +101,7 @@ setup_payload_download_request <- function(version = NULL,
 #' @param naomi_output Calibrated naomi output
 #'
 #' @return Calibrated naomi output matched to MWI test data on `naomi.resources` to be used to generate the agyw tool.
-#' @export
-
+#' @keywords internal
 make_agyw_testfiles <- function(naomi_output){
 
   # Create naomi outputs align with testing data in naomi.resources:
@@ -112,18 +110,18 @@ make_agyw_testfiles <- function(naomi_output){
   output <- naomi::read_hintr_output(naomi_output$model_output_path)
 
   # Areas
-  meta_area_demo <- dplyr::mutate(output$output_package$meta_area,
-                                  area_id = dplyr::if_else(area_id == "MWI", "MWI_demo", area_id),
-                                  parent_area_id = dplyr::if_else(parent_area_id == "MWI", "MWI_demo", parent_area_id))
-
-  meta_area_demo <- dplyr::filter(meta_area_demo, area_level <= 2)
+  meta_area_demo <- output$output_package$meta_area
+  meta_area_demo[meta_area_demo$area_id == "MWI", "area_id"] = "MWI_demo"
+  parent_area_id_replace <- meta_area_demo$parent_area_id == "MWI" &
+    !is.na(meta_area_demo$parent_area_id)
+  meta_area_demo[parent_area_id_replace, "parent_area_id"] = "MWI_demo"
+  meta_area_demo <- meta_area_demo[meta_area_demo$area_level <= 2, ]
 
   # Indicators
-  ind_demo <- dplyr::mutate(output$output_package$indicators,
-                            area_id = dplyr::if_else(area_id == "MWI", "MWI_demo", area_id))
-
-  ind_demo <- dplyr::filter(ind_demo, area_id %in% meta_area_demo$area_id)
-
+  ind_demo <- output$output_package$indicators
+  ind_replace <- ind_demo$area_id == "MWI" & !is.na(ind_demo$area_id)
+  ind_demo[ind_replace, "area_id"] <- "MWI_demo"
+  ind_demo <- ind_demo[ind_demo$area_id %in% meta_area_demo$area_id, ]
 
   # Options
   options_demo <- output$output_package$fit$model_options
@@ -140,11 +138,7 @@ make_agyw_testfiles <- function(naomi_output){
   naomi:::hintr_save(demo, out_demo)
 
   # Add to existing hintr_test data
-  agyw_output_demo <- naomi_output
-  agyw_output_demo$model_output_path <- out_demo
+  naomi_output$model_output_path <- out_demo
 
-  agyw_output_demo
+  naomi_output
 }
-
-
-
diff --git a/man/build_json.Rd b/man/build_json.Rd
diff --git a/man/make_agyw_testfiles.Rd b/man/make_agyw_testfiles.Rd
diff --git a/scripts/run_model b/scripts/run_model
@@ -84,7 +84,7 @@ output <- naomi::read_hintr_output(calibrated$model_output_path)
 
 if(output$output_package$fit$model_options$area_scope == "MWI"){
 
-  agyw_test_outputs <- make_agyw_testfiles(calibrated)
+  agyw_test_outputs <- hintr:::make_agyw_testfiles(calibrated)
 
 } else {
 

diff --git a/tests/testthat/helper-queue.R b/tests/testthat/helper-queue.R
@@ -88,6 +88,12 @@ test_queue_result <- function(model = mock_model, calibrate = mock_calibrate,
   )
 }
 
+add_queue_result <- function(queue, res) {
+  new_id <- queue$submit(quote(identity(res)))
+  queue$queue$task_wait(new_id)
+  new_id
+}
+
 prerun_inputs <- list(
   pjnz = "testdata/Malawi2019.PJNZ",
   population = "testdata/population.csv",

diff --git a/tests/testthat/test-01-endpoints-download.R b/tests/testthat/test-01-endpoints-download.R
@@ -857,14 +857,18 @@ test_that("api can create agyw download", {
   q <- test_queue_result()
   api <- api_build(q$queue)
 
+  res <- q$queue$result(q$calibrate_id)
+  agyw_result <- make_agyw_testfiles(res)
+  agyw_result_id <- add_queue_result(q$queue, agyw_result)
+
   ## Prepare body
   payload <- setup_payload_download_request(include_notes = FALSE,
                                             include_state = FALSE,
                                             include_pjnz = TRUE)
 
   ## Submit download request
   submit <- api$request("POST",
-                        paste0("/download/submit/agyw/", q$calibrate_id),
+                        paste0("/download/submit/agyw/", agyw_result_id),
                         body = payload)
   submit_body <- jsonlite::fromJSON(submit$body)
   expect_equal(submit$status, 200)