update (more) failing tests

mrc-ide · Dec 11, 2024 · 130a994 · 130a994
1 parent 6fcb1cb
commit 130a994
Show file tree

Hide file tree

Showing 3 changed files with 39 additions and 17 deletions.
diff --git a/R/warnings.R b/R/warnings.R
@@ -87,7 +87,7 @@ art_programme_data_warning <- function(art_naomi_spectrum_comparison) {
       value_naomi = sum(value_naomi),
       value_spectrum_adjusted = sum(value_spectrum_adjusted), .groups = "drop") |>
     dplyr::mutate(total_diff = value_naomi - value_spectrum_adjusted) |>
-    dplyr::filter(total_diff > 0) |>
+    dplyr::filter(abs(total_diff) > 0) |>
     dplyr::group_by(indicator) |>
     dplyr::summarise(years = paste0(year, collapse = ";"), .groups = "drop") |>
     dplyr::mutate(text = paste(indicator, years, sep = ": "))
@@ -134,13 +134,27 @@ anc_programme_data_warning <- function(anc_naomi_spectrum_comparison) {
 ##' This can throw validation errors or warnings which will be shown to user
 ##' in naomi web app
 ##'
-##' @param naomi_spectrum_comparison Comparison table of aggregated subnational
+##' @param art_naomi_spectrum_comparison Comparison table of aggregated subnational
+##' Naomi and national Spectrum programme data created by
+##' prepare_art_spectrum_comparison() or prepare_anc_spectrum_comparison()
+##'
+##' @export
+hintr_validate_art_programme_data <- function(art_naomi_spectrum_comparison) {
+  handle_naomi_warnings(art_programme_data_warning(art_naomi_spectrum_comparison))
+}
+
+##' Run validation for subnational programme data input
+##'
+##' This can throw validation errors or warnings which will be shown to user
+##' in naomi web app
+##'
+##' @param anc_naomi_spectrum_comparison Comparison table of aggregated subnational
 ##' Naomi and national Spectrum programme data created by
 ##' prepare_art_spectrum_comparison() or prepare_anc_spectrum_comparison()
 ##'
 ##' @export
-hintr_validate_programme_data <- function(naomi_spectrum_comparison) {
-  handle_naomi_warnings(programme_data_warning(naomi_spectrum_comparison))
+hintr_validate_anc_programme_data <- function(anc_naomi_spectrum_comparison) {
+  handle_naomi_warnings(anc_programme_data_warning(anc_naomi_spectrum_comparison))
 }
 
 

diff --git a/tests/testthat/test-input-comparison.R b/tests/testthat/test-input-comparison.R
@@ -73,33 +73,41 @@ test_that("Comparison wrapper function works with missing programme data", {
 
   x <- prepare_spectrum_naomi_comparison(art, anc, shape, pjnz)
 
-  expect_equal(unique(x$indicator), c("number_on_art", "anc_already_art", "anc_clients",
-                                      "anc_known_neg", "anc_known_pos", "anc_tested" , "anc_tested_pos"))
-  expect_equal(unique(x$group), c("art_children", "art_adult_both", "anc_adult_female"))
+  expect_equal(unique(x$art$indicator), c("number_on_art"))
+  expect_equal(unique(x$anc$indicator), c("anc_already_art", "anc_clients",
+                                          "anc_known_neg", "anc_known_pos",
+                                          "anc_tested" , "anc_tested_pos"))
+  expect_equal(unique(x$art$group), c("art_children", "art_adult_both"))
+  expect_equal(unique(x$anc$group), c("anc_adult_female"))
 
   # Test wrapper function with no ART
   art <- NULL
 
   x <- prepare_spectrum_naomi_comparison(art, anc, shape, pjnz)
 
-  expect_equal(unique(x$indicator), c("anc_already_art", "anc_clients", "anc_known_neg",
+  expect_equal(x$art, NULL)
+
+  expect_equal(unique(x$anc$indicator), c("anc_already_art", "anc_clients", "anc_known_neg",
                                       "anc_known_pos", "anc_tested" , "anc_tested_pos"))
-  expect_equal(unique(x$group), c("anc_adult_female"))
+  expect_equal(unique(x$anc$group), c("anc_adult_female"))
 
   # Test wrapper function with no ANC
   art <- a_hintr_data$art_number
   anc <- NULL
 
   x <- prepare_spectrum_naomi_comparison(art, anc, shape, pjnz)
 
-  expect_equal(unique(x$indicator), c("number_on_art"))
-  expect_equal(unique(x$group), c("art_children", "art_adult_both"))
+  expect_equal(x$anc, NULL)
+
+  expect_equal(unique(x$art$indicator), c("number_on_art"))
+  expect_equal(unique(x$art$group), c("art_children", "art_adult_both"))
 
   # Test wrapper function with no programme data
   art <- NULL
 
   x <- prepare_spectrum_naomi_comparison(art, anc, shape, pjnz)
-  expect_equal(nrow(x), 0)
+  expect_equal(x$art, NULL)
+  expect_equal(x$anc, NULL)
 
 })
 

diff --git a/tests/testthat/test-warning.R b/tests/testthat/test-warning.R
@@ -61,7 +61,7 @@ test_that("warning raised after false convergence", {
 
   expect_length(out$warnings, 3)
   expect_match(out$warnings[[1]]$text,
-               "Naomi subnational data not equal to Spectrum national data. Check table on review inputs tab for: \nnumber_on_art: 2019;2021;2022;2023")
+               "Naomi subnational data not equal to Spectrum national data. Check table on review inputs tab for: \nnumber_on_art: 2011;2012;2013;2014;2015;2016;2017;2018;2019;2020;2021;2022;2023")
   expect_match(out$warnings[[2]]$text,
                "Naomi subnational data not equal to Spectrum national data. Check table on review inputs tab for: \nanc_already_art: 2012;2013;2014;2015;2016;2017;2018;2019;2020;2021;2022;2023\nanc_clients: 2012;2013;2014;2015;2016;2017;2018;2019;2020;2021;2022;2023\nanc_known_neg: 2013;2014;2015;2016;2017;2018;2019;2020;2021;2022;2023\nanc_known_pos: 2012;2013;2014;2015;2016;2017;2018;2019;2020;2021;2022;2023\nanc_tested: 2012;2013;2014;2015;2016;2017;2018;2019;2020;2021;2022;2023")
   expect_equal(out$warnings[[3]]$text,
@@ -130,8 +130,8 @@ test_that("ART warning raised if spectrum totals do not match naomi data", {
   )
 
   # National warnings for national pjnz file
-  spec_comparison <- prepare_art_spectrum_comparison(data$art_number, data$shape, data$pjnz)
-  art <- hintr_validate_programme_data(spec_comparison)
+  art_spec_comparison <- prepare_art_spectrum_comparison(data$art_number, data$shape, data$pjnz)
+  art <- hintr_validate_art_programme_data(art_spec_comparison)
 
   expect_length(art$warnings, 1)
   expect_equal(art$warnings[[1]]$locations,
@@ -151,8 +151,8 @@ test_that("ANC warning raised if spectrum totals do not match naomi data", {
   )
 
   # National warnings for national pjnz file
-  spec_comparison <- prepare_anc_spectrum_comparison(data$anc_testing, data$shape, data$pjnz)
-  anc <- hintr_validate_programme_data(spec_comparison)
+  anc_spec_comparison <- prepare_anc_spectrum_comparison(data$anc_testing, data$shape, data$pjnz)
+  anc <- hintr_validate_anc_programme_data(anc_spec_comparison)
 
   expect_length(anc$warnings, 1)
   expect_equal(anc$warnings[[1]]$locations,