diff --git a/R/warnings.R b/R/warnings.R index 4ef1ffc7..d69a6f30 100644 --- 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 index a329667e..d0df4386 100644 --- a/tests/testthat/test-input-comparison.R +++ b/tests/testthat/test-input-comparison.R @@ -73,18 +73,23 @@ 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 @@ -92,14 +97,17 @@ 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")) - 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 index d3306dfc..2692df5a 100644 --- 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,