From db10a68f12770c25e1c01038741f6e74a9fe0eeb Mon Sep 17 00:00:00 2001 From: Tom Jemmett Date: Mon, 2 Feb 2026 17:32:45 +0000 Subject: [PATCH 01/47] adds testthat package --- DESCRIPTION | 3 +++ tests/testthat.R | 12 ++++++++++++ 2 files changed, 15 insertions(+) create mode 100644 tests/testthat.R diff --git a/DESCRIPTION b/DESCRIPTION index 9e568d1..d067e5c 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -44,3 +44,6 @@ Remotes: Encoding: UTF-8 Roxygen: list(markdown = TRUE) RoxygenNote: 7.3.3 +Suggests: + testthat (>= 3.0.0) +Config/testthat/edition: 3 diff --git a/tests/testthat.R b/tests/testthat.R new file mode 100644 index 0000000..99f4fcf --- /dev/null +++ b/tests/testthat.R @@ -0,0 +1,12 @@ +# This file is part of the standard setup for testthat. +# It is recommended that you do not modify it. +# +# Where should you do additional test configuration? +# Learn more about the roles of various files in: +# * https://r-pkgs.org/testing-design.html#sec-tests-files-overview +# * https://testthat.r-lib.org/articles/special-files.html + +library(testthat) +library(tpma.explorer) + +test_check("tpma.explorer") From 6ce44078106def7fbe12331e57806a39f103ff81 Mon Sep 17 00:00:00 2001 From: Tom Jemmett Date: Mon, 2 Feb 2026 17:33:33 +0000 Subject: [PATCH 02/47] adds tests for app_server --- tests/testthat/test-app_server.R | 305 +++++++++++++++++++++++++++++++ 1 file changed, 305 insertions(+) create mode 100644 tests/testthat/test-app_server.R diff --git a/tests/testthat/test-app_server.R b/tests/testthat/test-app_server.R new file mode 100644 index 0000000..3671fbd --- /dev/null +++ b/tests/testthat/test-app_server.R @@ -0,0 +1,305 @@ +library(mockery) +library(testthat) + +inputs_data_sample <- list( + "age_sex" = NULL, + "diagnoses" = NULL, + "procedures" = NULL, + "rates" = tibble::tribble( + ~provider , ~strategy , ~fyear , ~rate , + "ABC" , "strategy" , 1 , 12.3 , + "ABC" , "strategy" , 2 , 15.6 + ) +) + +setup_app_server_tests <- function(.env = parent.frame()) { + shiny::shinyOptions(cache = cachem::cache_mem()) + + mocks <- list( + mod_select_geography_server = mock(shiny::reactiveVal("nhp")), + mod_select_provider_server = mock(shiny::reactiveVal("ABC")), + mod_select_strategy_server = mock(shiny::reactiveVal("strategy")), + get_all_geo_data = mock(inputs_data_sample, cycle = TRUE), + mod_show_strategy_text_server = mock(), + mod_plot_rates_server = mock(), + mod_table_procedures_server = mock(), + mod_table_diagnoses_server = mock(), + mod_plot_age_sex_pyramid_server = mock(), + mod_plot_nee_server = mock() + ) + + do.call(testthat::local_mocked_bindings, c(mocks, .env = .env)) + + mocks +} + +test_that("mod_select_geography", { + # arrange + mocks <- setup_app_server_tests() + + # act + shiny::testServer( + app_server, + { + # assert + expect_called(mocks$mod_select_geography_server, 1) + expect_args(mocks$mod_select_geography_server, 1, "mod_select_geography") + } + ) +}) + +test_that("mod_select_provider", { + # arrange + mocks <- setup_app_server_tests() + + # act + shiny::testServer( + app_server, + { + # assert + expect_called(mocks$mod_select_provider_server, 1) + expect_args( + mocks$mod_select_provider_server, + 1, + "mod_select_provider", + selected_geography + ) + } + ) +}) + +test_that("mod_select_strategy", { + # arrange + mocks <- setup_app_server_tests() + + # act + shiny::testServer( + app_server, + { + # assert + expect_called(mocks$mod_select_strategy_server, 1) + expect_args( + mocks$mod_select_strategy_server, + 1, + "mod_select_strategy" + ) + } + ) +}) + +test_that("selected_year (env var not set)", { + # arrange + mocks <- setup_app_server_tests() + + # act + shiny::testServer( + app_server, + { + # assert + withr::local_envvar("BASELINE_YEAR" = "") + expect_equal(selected_year(), 2) + expect_called(mocks$get_all_geo_data, 1) + expect_args(mocks$get_all_geo_data, 1, "nhp") + } + ) +}) + + +test_that("selected_year (env var set)", { + # arrange + mocks <- setup_app_server_tests() + + # act + shiny::testServer( + app_server, + { + # assert + withr::local_envvar("BASELINE_YEAR" = "3") + expect_equal(selected_year(), 3) + expect_called(mocks$get_all_geo_data, 0) + } + ) +}) + +test_that("inputs_data", { + # arrange + mocks <- setup_app_server_tests() + + # act + shiny::testServer( + app_server, + { + # assert + withr::local_envvar("BASELINE_YEAR" = "") + expect_equal(inputs_data(), inputs_data_sample) + expect_called(mocks$get_all_geo_data, 1) + expect_args(mocks$get_all_geo_data, 1, "nhp") + + # test caching - not changing geography, so shouldn't call again + inputs_data() + expect_called(mocks$get_all_geo_data, 1) + + # test caching - changing geography, so should call again + selected_geography("la") + inputs_data() + expect_called(mocks$get_all_geo_data, 2) + expect_args(mocks$get_all_geo_data, 2, "la") + + # test caching - changing geography back, so shouldn't call again + selected_geography("nhp") + inputs_data() + expect_called(mocks$get_all_geo_data, 2) + } + ) +}) + +test_that("sidebar accordion opens", { + # arrange + mocks <- setup_app_server_tests() + + m <- mock() + mockery::stub(app_server, "bslib::accordion_panel_open", m) + # act + + shiny::testServer( + app_server, + { + session$private$flush() # trigger observer + expect_called(m, 1) + expect_args(m, 1, id = "sidebar_accordion", values = TRUE) + } + ) +}) + +test_that("mod_show_strategy_text_server", { + # arrange + mocks <- setup_app_server_tests() + + # act + shiny::testServer( + app_server, + { + # assert + expect_called(mocks$mod_show_strategy_text_server, 1) + expect_args( + mocks$mod_show_strategy_text_server, + 1, + "mod_show_strategy_text", + selected_strategy + ) + } + ) +}) + +test_that("mod_plot_rates_server", { + # arrange + mocks <- setup_app_server_tests() + + # act + shiny::testServer( + app_server, + { + # assert + expect_called(mocks$mod_plot_rates_server, 1) + expect_args( + mocks$mod_plot_rates_server, + 1, + "mod_plot_rates", + inputs_data, + selected_geography, + selected_provider, + selected_strategy, + selected_year + ) + } + ) +}) + +test_that("mod_table_procedures_server", { + # arrange + mocks <- setup_app_server_tests() + + # act + shiny::testServer( + app_server, + { + # assert + expect_called(mocks$mod_table_procedures_server, 1) + expect_args( + mocks$mod_table_procedures_server, + 1, + "mod_table_procedures", + inputs_data, + selected_provider, + selected_strategy, + selected_year + ) + } + ) +}) + +test_that("mod_table_diagnoses_server", { + # arrange + mocks <- setup_app_server_tests() + + # act + shiny::testServer( + app_server, + { + # assert + expect_called(mocks$mod_table_diagnoses_server, 1) + expect_args( + mocks$mod_table_diagnoses_server, + 1, + "mod_table_diagnoses", + inputs_data, + selected_provider, + selected_strategy, + selected_year + ) + } + ) +}) + +test_that("mod_plot_age_sex_pyramid_server", { + # arrange + mocks <- setup_app_server_tests() + + # act + shiny::testServer( + app_server, + { + # assert + expect_called(mocks$mod_plot_age_sex_pyramid_server, 1) + expect_args( + mocks$mod_plot_age_sex_pyramid_server, + 1, + "mod_plot_age_sex_pyramid", + inputs_data, + selected_provider, + selected_strategy, + selected_year + ) + } + ) +}) + +test_that("mod_plot_nee_server", { + # arrange + mocks <- setup_app_server_tests() + + # act + shiny::testServer( + app_server, + { + # assert + expect_called(mocks$mod_plot_nee_server, 1) + expect_args( + mocks$mod_plot_nee_server, + 1, + "mod_plot_nee", + selected_strategy + ) + } + ) +}) From 907789f30427a1f9af449caf89cbfcc658905dc5 Mon Sep 17 00:00:00 2001 From: Tom Jemmett Date: Mon, 2 Feb 2026 17:34:56 +0000 Subject: [PATCH 03/47] adds tests for fct_azure --- tests/testthat/test-fct_azure.R | 66 +++++++++++++++++++++++++++++++++ 1 file changed, 66 insertions(+) create mode 100644 tests/testthat/test-fct_azure.R diff --git a/tests/testthat/test-fct_azure.R b/tests/testthat/test-fct_azure.R new file mode 100644 index 0000000..25a75fd --- /dev/null +++ b/tests/testthat/test-fct_azure.R @@ -0,0 +1,66 @@ +library(mockery) + +test_that("get_container uses get_azure_token when not in a managed environment", { + # arrange + m_get_managed_token <- \() stop("expected error") + m_get_azure_token <- mock("token") + m_blob_endpoint <- mock("ep") + m_storage_container <- mock("container") + + stub(get_container, "AzureAuth::get_managed_token", m_get_managed_token) + stub(get_container, "AzureAuth::get_azure_token", m_get_azure_token) + stub(get_container, "AzureStor::blob_endpoint", m_blob_endpoint) + stub(get_container, "AzureStor::storage_container", m_storage_container) + + # act + actual <- get_container("ep_uri", "container_name") + + # assert + expect_called(m_get_azure_token, 1) + expect_args( + m_get_azure_token, + 1, + resource = "https://storage.azure.com", + tenant = "common", + app = "04b07795-8ddb-461a-bbee-02f9e1bf7b46", + use_cache = TRUE + ) + + expect_called(m_blob_endpoint, 1) + expect_args(m_blob_endpoint, 1, "ep_uri", token = "token") + + expect_called(m_storage_container, 1) + expect_args(m_storage_container, 1, "ep", "container_name") + + expect_equal(actual, "container") +}) + +test_that("get_container uses get_managed_token when in a managed environment", { + # arrange + m_get_managed_token <- mock("token") + m_get_azure_token <- mock() + m_blob_endpoint <- mock("ep") + m_storage_container <- mock("container") + + stub(get_container, "AzureAuth::get_managed_token", m_get_managed_token) + stub(get_container, "AzureAuth::get_azure_token", m_get_azure_token) + stub(get_container, "AzureStor::blob_endpoint", m_blob_endpoint) + stub(get_container, "AzureStor::storage_container", m_storage_container) + + # act + actual <- get_container("ep_uri", "container_name") + + # assert + expect_called(m_get_managed_token, 1) + expect_args(m_get_managed_token, 1, "https://storage.azure.com/") + + expect_called(m_get_azure_token, 0) + + expect_called(m_blob_endpoint, 1) + expect_args(m_blob_endpoint, 1, "ep_uri", token = "token") + + expect_called(m_storage_container, 1) + expect_args(m_storage_container, 1, "ep", "container_name") + + expect_equal(actual, "container") +}) From 3ff6ac5d5c2eabdd29ad394950090d5983574344 Mon Sep 17 00:00:00 2001 From: Tom Jemmett Date: Mon, 2 Feb 2026 22:17:37 +0000 Subject: [PATCH 04/47] add tests for mod_pot_age_sex_pyramid --- .../_snaps/mod_plot_age_sex_pyramid.md | 33 +++++ .../testthat/test-mod_plot_age_sex_pyramid.R | 118 ++++++++++++++++++ 2 files changed, 151 insertions(+) create mode 100644 tests/testthat/_snaps/mod_plot_age_sex_pyramid.md create mode 100644 tests/testthat/test-mod_plot_age_sex_pyramid.R diff --git a/tests/testthat/_snaps/mod_plot_age_sex_pyramid.md b/tests/testthat/_snaps/mod_plot_age_sex_pyramid.md new file mode 100644 index 0000000..633f67c --- /dev/null +++ b/tests/testthat/_snaps/mod_plot_age_sex_pyramid.md @@ -0,0 +1,33 @@ +# ui + + Code + ui + Output +
+
+
+ Age-sex pyramid + + + + +
+
+ +
+ + + + + +
+
+ diff --git a/tests/testthat/test-mod_plot_age_sex_pyramid.R b/tests/testthat/test-mod_plot_age_sex_pyramid.R new file mode 100644 index 0000000..69f2a83 --- /dev/null +++ b/tests/testthat/test-mod_plot_age_sex_pyramid.R @@ -0,0 +1,118 @@ +library(mockery) +library(testthat) + +inputs_data_sample <- list( + "age_sex" = tibble::tribble( + ~provider , ~strategy , ~fyear , + "R00" , "a" , 1 , + "R00" , "a" , 2 , + "R00" , "b" , 1 , + "R00" , "b" , 2 , + "R01" , "a" , 1 , + "R01" , "a" , 2 , + "R01" , "b" , 1 , + "R01" , "b" , 2 , + ) +) + +test_that("ui", { + testthat::local_mocked_bindings( + "p_randomInt" = \(...) "X", + .package = "shiny" + ) + + ui <- mod_plot_age_sex_pyramid_ui("test") + + expect_snapshot(ui) +}) + +test_that("age_sex_data", { + # arrange + m <- mock("age_sex_data") + testthat::local_mocked_bindings("prepare_age_sex_data" = m) + expected <- tibble::tibble(provider = "R00", strategy = "a", fyear = 2) + + # act + shiny::testServer( + mod_plot_age_sex_pyramid_server, + args = list( + inputs_data = reactiveVal(inputs_data_sample), + selected_provider = reactiveVal("R00"), + selected_strategy = reactiveVal("a"), + selected_year = reactiveVal(2) + ), + { + actual <- age_sex_data() + + # assert + expect_equal(actual, "age_sex_data") + + expect_called(m, 1) + expect_args(m, 1, expected) + } + ) +}) + +test_that("age_sex_pyramid (no rows)", { + # arrange + testthat::local_mocked_bindings("prepare_age_sex_data" = \(...) { + tibble::tibble() + }) + + # act + shiny::testServer( + mod_plot_age_sex_pyramid_server, + args = list( + inputs_data = reactiveVal(inputs_data_sample), + selected_provider = reactiveVal("R00"), + selected_strategy = reactiveVal("a"), + selected_year = reactiveVal(2) + ), + { + # assert + expect_error( + output$age_sex_pyramid, + "No data available for these selections." + ) + } + ) +}) + + +test_that("age_sex_pyramid (with rows)", { + # arrange + m <- mock("plot") + testthat::local_mocked_bindings( + "prepare_age_sex_data" = identity, + "plot_age_sex_pyramid" = m + ) + + # replace renderPlot to avoid actual plotting, replace with renderText so we + # can simply check the output + testthat::local_mocked_bindings( + "renderPlot" = shiny::renderText, + .package = "shiny" + ) + + expected <- tibble::tibble(provider = "R00", strategy = "a", fyear = 2) + + # act + shiny::testServer( + mod_plot_age_sex_pyramid_server, + args = list( + inputs_data = reactiveVal(inputs_data_sample), + selected_provider = reactiveVal("R00"), + selected_strategy = reactiveVal("a"), + selected_year = reactiveVal(2) + ), + { + actual <- output$age_sex_pyramid + + # assert + expect_equal(actual, "plot") + + expect_called(m, 1) + expect_args(m, 1, expected) + } + ) +}) From 20a29389d6719e08dba01dc5dd8ad088aba4e43e Mon Sep 17 00:00:00 2001 From: Tom Jemmett Date: Mon, 2 Feb 2026 22:30:27 +0000 Subject: [PATCH 05/47] adds tests for mod_plot_nee --- tests/testthat/_snaps/mod_plot_nee.md | 35 +++++++++++ tests/testthat/test-mod_plot_nee.R | 89 +++++++++++++++++++++++++++ 2 files changed, 124 insertions(+) create mode 100644 tests/testthat/_snaps/mod_plot_nee.md create mode 100644 tests/testthat/test-mod_plot_nee.R diff --git a/tests/testthat/_snaps/mod_plot_nee.md b/tests/testthat/_snaps/mod_plot_nee.md new file mode 100644 index 0000000..c312fe7 --- /dev/null +++ b/tests/testthat/_snaps/mod_plot_nee.md @@ -0,0 +1,35 @@ +# ui + + Code + ui + Output +
+
+
+ National Elicitation Exercise (NEE) estimate + + + + +
+
+ +
+ + + + + +
+
+ diff --git a/tests/testthat/test-mod_plot_nee.R b/tests/testthat/test-mod_plot_nee.R new file mode 100644 index 0000000..34c4ebd --- /dev/null +++ b/tests/testthat/test-mod_plot_nee.R @@ -0,0 +1,89 @@ +library(mockery) +library(testthat) + +test_that("ui", { + testthat::local_mocked_bindings( + "p_randomInt" = \(...) "X", + .package = "shiny" + ) + + ui <- mod_plot_nee_ui("test") + + expect_snapshot(ui) +}) + +test_that("selected_nee_data", { + # arrange + expected <- tibble::tibble( + param_name = "smoking", + mean = 84.3, + percentile10 = 98.9, + percentile90 = 60.0 + ) + + # act + shiny::testServer( + mod_plot_nee_server, + args = list( + selected_strategy = reactiveVal("smoking") + ), + { + actual <- selected_nee_data() + + # assert + expect_equal(actual, expected, tolerance = 1e-1) + } + ) +}) + +test_that("nee (no rows)", { + # arrange + testthat::local_mocked_bindings("prepare_age_sex_data" = \(...) { + tibble::tibble() + }) + + # act + shiny::testServer( + mod_plot_nee_server, + args = list( + selected_strategy = reactiveVal("X") + ), + { + # assert + expect_error(output$nee) + } + ) +}) + + +test_that("nee (with rows)", { + # arrange + m <- mock("plot") + testthat::local_mocked_bindings( + "plot_nee" = m + ) + + # replace renderPlot to avoid actual plotting, replace with renderText so we + # can simply check the output + testthat::local_mocked_bindings( + "renderPlot" = shiny::renderText, + .package = "shiny" + ) + + # act + shiny::testServer( + mod_plot_nee_server, + args = list( + selected_strategy = reactiveVal("smoking") + ), + { + actual <- output$nee + + # assert + expect_equal(actual, "plot") + + expect_called(m, 1) + expect_call(m, 1, plot_nee(df)) + } + ) +}) From e9c16c088efdf59184e35bb54e76dfde55585887 Mon Sep 17 00:00:00 2001 From: Tom Jemmett Date: Mon, 2 Feb 2026 22:36:10 +0000 Subject: [PATCH 06/47] adds test for app_ui --- tests/testthat/_snaps/app_ui.md | 197 ++++++++++++++++++++++++++++++++ tests/testthat/test-app_ui.R | 53 +++++++++ 2 files changed, 250 insertions(+) create mode 100644 tests/testthat/_snaps/app_ui.md create mode 100644 tests/testthat/test-app_ui.R diff --git a/tests/testthat/_snaps/app_ui.md b/tests/testthat/_snaps/app_ui.md new file mode 100644 index 0000000..f77fae1 --- /dev/null +++ b/tests/testthat/_snaps/app_ui.md @@ -0,0 +1,197 @@ +# ui + + Code + ui + Output + + +
+
+
+
+
+
+
+
+ + Warning +
+
+ This app is in development and its output has not been verified. + The information presented here should not be relied on as fact. +
+ +
+ +
mod_show_strategy_text
+
+
+
mod_plot_rates
+
+
+
mod_table_procedures
+
mod_table_diagnoses
+
+
+
+
+
mod_plot_age_sex_pyramid
+
mod_plot_nee
+
+
+
+
+ +
+
+ +
+ +
+
+
Purpose
+

View summaries of data for Types of Potentially-Mitigatable Activity (TPMAs) for statistical units within different geographical categories.

+
+ +
+
+
+
+
Definitions
+

Visit the New Hospital Programme (NHP) project information website to:

+ +
+ +
+
+
+
+
Data
+

Placeholder.

+
+ +
+
+ +
+
+ +
+
+
Navigation
+

First, make selections in the left-hand panel:

+
    +
  1. From the Visualisations section: +
      +
    • Select from the Filter by geography dropdown to choose a geographical categorisation.
      • +
    • Select a statistical unit from the Choose dropdown to view its data.
      • +
    +
    2. +
  2. From the Types of potentially mitigatable activity (TPMAs) section: +
      +
    • Select from the Filter by activity type dropdown to choose from a category of TPMAs.
      • +
    • Select a TPMA from the Choose a TPMA dropdown to view data for that TPMA (your selections will automatically update the content of the Data section of the app).
      • +
    +
    3. +
  3. Use the navigation bar at the top to visit different sections of the app. Visit the: +
      +
    • Information tab (current tab) for background information and instructions.
      • +
    • Visualisations tab to view a description of the selected TPMA
      • +
    +
    4. +
+
+ +
+
+
+
+
Interface
+

You can hover over the information symbol () for further information about a visualisation.

+

To maximise the space for visualisations, you can:

+
    +
  • click the expand button () in the lower-right of a plot to expand to full screen
    • +
  • collapse the sidebar by clicking the toggle sidebar chevron in its upper-right corner
    • +
+
+ +
+
+ +
+ +
+
+
+
+ + + +
+
+ + diff --git a/tests/testthat/test-app_ui.R b/tests/testthat/test-app_ui.R new file mode 100644 index 0000000..a0131c7 --- /dev/null +++ b/tests/testthat/test-app_ui.R @@ -0,0 +1,53 @@ +library(mockery) + +test_that("ui", { + testthat::local_mocked_bindings( + "p_randomInt" = \(...) "X", + .package = "shiny" + ) + + mocks <- list( + "mod_show_strategy_text_ui" = mock("mod_show_strategy_text"), + "mod_plot_rates_ui" = mock("mod_plot_rates"), + "mod_table_procedures_ui" = mock("mod_table_procedures"), + "mod_table_diagnoses_ui" = mock("mod_table_diagnoses"), + "mod_plot_age_sex_pyramid_ui" = mock("mod_plot_age_sex_pyramid"), + "mod_plot_nee_ui" = mock("mod_plot_nee"), + "mod_select_geography_ui" = mock("mod_select_geography"), + "mod_select_provider_ui" = mock("mod_select_provider"), + "mod_select_strategy_ui" = mock("mod_select_strategy") + ) + + do.call(testthat::local_mocked_bindings, c(mocks, .env = .env)) + + ui <- app_ui("request") + + expect_snapshot(ui) + + expect_called(mocks$mod_show_strategy_text_ui, 1) + expect_args(mocks$mod_show_strategy_text_ui, 1, "mod_show_strategy_text") + + expect_called(mocks$mod_plot_rates_ui, 1) + expect_args(mocks$mod_plot_rates_ui, 1, "mod_plot_rates") + + expect_called(mocks$mod_table_procedures_ui, 1) + expect_args(mocks$mod_table_procedures_ui, 1, "mod_table_procedures") + + expect_called(mocks$mod_table_diagnoses_ui, 1) + expect_args(mocks$mod_table_diagnoses_ui, 1, "mod_table_diagnoses") + + expect_called(mocks$mod_plot_age_sex_pyramid_ui, 1) + expect_args(mocks$mod_plot_age_sex_pyramid_ui, 1, "mod_plot_age_sex_pyramid") + + expect_called(mocks$mod_plot_nee_ui, 1) + expect_args(mocks$mod_plot_nee_ui, 1, "mod_plot_nee") + + expect_called(mocks$mod_select_geography_ui, 1) + expect_args(mocks$mod_select_geography_ui, 1, "mod_select_geography") + + expect_called(mocks$mod_select_provider_ui, 1) + expect_args(mocks$mod_select_provider_ui, 1, "mod_select_provider") + + expect_called(mocks$mod_select_strategy_ui, 1) + expect_args(mocks$mod_select_strategy_ui, 1, "mod_select_strategy") +}) From edd97cf276d749e0922f1bf292299c4f72f248dc Mon Sep 17 00:00:00 2001 From: Tom Jemmett Date: Tue, 3 Feb 2026 09:02:50 +0000 Subject: [PATCH 07/47] add tests for mod_plot_rates_box --- tests/testthat/_snaps/mod_plot_rates_box.md | 35 +++++++++++ tests/testthat/test-mod_plot_rates_box.R | 70 +++++++++++++++++++++ 2 files changed, 105 insertions(+) create mode 100644 tests/testthat/_snaps/mod_plot_rates_box.md create mode 100644 tests/testthat/test-mod_plot_rates_box.R diff --git a/tests/testthat/_snaps/mod_plot_rates_box.md b/tests/testthat/_snaps/mod_plot_rates_box.md new file mode 100644 index 0000000..ace3069 --- /dev/null +++ b/tests/testthat/_snaps/mod_plot_rates_box.md @@ -0,0 +1,35 @@ +# ui + + Code + ui + Output +
+
+
+ Rates Box + + + + +
+
+ +
+ + + + + +
+
+ diff --git a/tests/testthat/test-mod_plot_rates_box.R b/tests/testthat/test-mod_plot_rates_box.R new file mode 100644 index 0000000..fb8fa7d --- /dev/null +++ b/tests/testthat/test-mod_plot_rates_box.R @@ -0,0 +1,70 @@ +library(mockery) +library(testthat) + +test_that("ui", { + testthat::local_mocked_bindings( + "p_randomInt" = \(...) "X", + .package = "shiny" + ) + + ui <- mod_plot_rates_box_ui("test") + + expect_snapshot(ui) +}) + + +test_that("rates_box_plot (no rows)", { + # arrange + + # act + shiny::testServer( + mod_plot_rates_box_server, + args = list( + rates = \() tibble::tibble(), + y_axis_limits = \() c(0, 100) + ), + { + # assert + expect_error( + output$rates_box_plot, + "No data available for these selections." + ) + } + ) +}) + + +test_that("rates_box_plot (with rows)", { + # arrange + m <- mock("plot") + testthat::local_mocked_bindings( + "plot_rates_box" = m + ) + + # replace renderPlot to avoid actual plotting, replace with renderText so we + # can simply check the output + testthat::local_mocked_bindings( + "renderPlot" = shiny::renderText, + .package = "shiny" + ) + + sample_data = tibble::tibble(x = 1, y = 2) + + # act + shiny::testServer( + mod_plot_rates_box_server, + args = list( + rates = \() sample_data, + y_axis_limits = \() c(0, 100) + ), + { + actual <- output$rates_box_plot + + # assert + expect_equal(actual, "plot") + + expect_called(m, 1) + expect_args(m, 1, sample_data, c(0, 100)) + } + ) +}) From 2bbd0350f44264c24d0b9ed0996025f7df57ff5a Mon Sep 17 00:00:00 2001 From: Tom Jemmett Date: Tue, 3 Feb 2026 09:11:44 +0000 Subject: [PATCH 08/47] fix test for app_ui --- tests/testthat/test-app_ui.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-app_ui.R b/tests/testthat/test-app_ui.R index a0131c7..19e452f 100644 --- a/tests/testthat/test-app_ui.R +++ b/tests/testthat/test-app_ui.R @@ -18,7 +18,7 @@ test_that("ui", { "mod_select_strategy_ui" = mock("mod_select_strategy") ) - do.call(testthat::local_mocked_bindings, c(mocks, .env = .env)) + do.call(testthat::local_mocked_bindings, c(mocks)) ui <- app_ui("request") From 446577b133d3ef02ab0e6374bbd3edc93d5c7207 Mon Sep 17 00:00:00 2001 From: Tom Jemmett Date: Tue, 3 Feb 2026 09:11:58 +0000 Subject: [PATCH 09/47] add tests for mod_plot_rates_funnel --- .../testthat/_snaps/mod_plot_rates_funnel.md | 35 +++++++++ tests/testthat/test-mod_plot_rates_funnel.R | 74 +++++++++++++++++++ 2 files changed, 109 insertions(+) create mode 100644 tests/testthat/_snaps/mod_plot_rates_funnel.md create mode 100644 tests/testthat/test-mod_plot_rates_funnel.R diff --git a/tests/testthat/_snaps/mod_plot_rates_funnel.md b/tests/testthat/_snaps/mod_plot_rates_funnel.md new file mode 100644 index 0000000..62b3f4c --- /dev/null +++ b/tests/testthat/_snaps/mod_plot_rates_funnel.md @@ -0,0 +1,35 @@ +# ui + + Code + ui + Output +
+
+
+ Rates Funnel + + + + +
+
+ +
+ + + + + +
+
+ diff --git a/tests/testthat/test-mod_plot_rates_funnel.R b/tests/testthat/test-mod_plot_rates_funnel.R new file mode 100644 index 0000000..6252f31 --- /dev/null +++ b/tests/testthat/test-mod_plot_rates_funnel.R @@ -0,0 +1,74 @@ +library(mockery) +library(testthat) + +test_that("ui", { + testthat::local_mocked_bindings( + "p_randomInt" = \(...) "X", + .package = "shiny" + ) + + ui <- mod_plot_rates_funnel_ui("test") + + expect_snapshot(ui) +}) + + +test_that("rates_funnel_plot (no rows)", { + # arrange + + # act + shiny::testServer( + mod_plot_rates_funnel_server, + args = list( + rates = \() tibble::tibble(), + funnel_calculations = \() "funnel calculations", + y_axis_limits = \() c(0, 100), + x_axis_title = \() "X Axis" + ), + { + # assert + expect_error( + output$rates_funnel_plot, + "No data available for these selections." + ) + } + ) +}) + + +test_that("rates_funnel_plot (with rows)", { + # arrange + m <- mock("plot") + testthat::local_mocked_bindings( + "plot_rates_funnel" = m + ) + + # replace renderPlot to avoid actual plotting, replace with renderText so we + # can simply check the output + testthat::local_mocked_bindings( + "renderPlot" = shiny::renderText, + .package = "shiny" + ) + + sample_data = tibble::tibble(x = 1, y = 2) + + # act + shiny::testServer( + mod_plot_rates_funnel_server, + args = list( + rates = \() sample_data, + funnel_calculations = \() "funnel calculations", + y_axis_limits = \() c(0, 100), + x_axis_title = \() "X Axis" + ), + { + actual <- output$rates_funnel_plot + + # assert + expect_equal(actual, "plot") + + expect_called(m, 1) + expect_args(m, 1, sample_data, "funnel calculations", c(0, 100), "X Axis") + } + ) +}) From d863021f87a279046f2232c28e05c023b45ca0b0 Mon Sep 17 00:00:00 2001 From: Tom Jemmett Date: Tue, 3 Feb 2026 09:15:19 +0000 Subject: [PATCH 10/47] adds tests for mod_plot_rates_trend --- tests/testthat/_snaps/mod_plot_rates_trend.md | 33 ++++++++ tests/testthat/test-mod_plot_rates_box.R | 2 +- tests/testthat/test-mod_plot_rates_funnel.R | 2 +- tests/testthat/test-mod_plot_rates_trend.R | 76 +++++++++++++++++++ 4 files changed, 111 insertions(+), 2 deletions(-) create mode 100644 tests/testthat/_snaps/mod_plot_rates_trend.md create mode 100644 tests/testthat/test-mod_plot_rates_trend.R diff --git a/tests/testthat/_snaps/mod_plot_rates_trend.md b/tests/testthat/_snaps/mod_plot_rates_trend.md new file mode 100644 index 0000000..6cad1b5 --- /dev/null +++ b/tests/testthat/_snaps/mod_plot_rates_trend.md @@ -0,0 +1,33 @@ +# ui + + Code + ui + Output +
+
+
+ Rates Trend + + + + +
+
+ +
+ + + + + +
+
+ diff --git a/tests/testthat/test-mod_plot_rates_box.R b/tests/testthat/test-mod_plot_rates_box.R index fb8fa7d..45f6c98 100644 --- a/tests/testthat/test-mod_plot_rates_box.R +++ b/tests/testthat/test-mod_plot_rates_box.R @@ -48,7 +48,7 @@ test_that("rates_box_plot (with rows)", { .package = "shiny" ) - sample_data = tibble::tibble(x = 1, y = 2) + sample_data <- tibble::tibble(x = 1, y = 2) # act shiny::testServer( diff --git a/tests/testthat/test-mod_plot_rates_funnel.R b/tests/testthat/test-mod_plot_rates_funnel.R index 6252f31..547e241 100644 --- a/tests/testthat/test-mod_plot_rates_funnel.R +++ b/tests/testthat/test-mod_plot_rates_funnel.R @@ -50,7 +50,7 @@ test_that("rates_funnel_plot (with rows)", { .package = "shiny" ) - sample_data = tibble::tibble(x = 1, y = 2) + sample_data <- tibble::tibble(x = 1, y = 2) # act shiny::testServer( diff --git a/tests/testthat/test-mod_plot_rates_trend.R b/tests/testthat/test-mod_plot_rates_trend.R new file mode 100644 index 0000000..bcb372d --- /dev/null +++ b/tests/testthat/test-mod_plot_rates_trend.R @@ -0,0 +1,76 @@ +library(mockery) +library(testthat) + +test_that("ui", { + testthat::local_mocked_bindings( + "p_randomInt" = \(...) "X", + .package = "shiny" + ) + + ui <- mod_plot_rates_trend_ui("test") + + expect_snapshot(ui) +}) + + +test_that("rates_trend_plot (no rows)", { + # arrange + + # act + shiny::testServer( + mod_plot_rates_trend_server, + args = list( + rates = \() tibble::tibble(), + y_axis_limits = \() c(0, 100), + y_axis_title = \() "Y Axis", + y_labels = \() "Y Labels", + selected_year = \() 202324 + ), + { + # assert + expect_error( + output$rates_trend_plot, + "No data available for these selections." + ) + } + ) +}) + + +test_that("rates_trend_plot (with rows)", { + # arrange + m <- mock("plot") + testthat::local_mocked_bindings( + "plot_rates_trend" = m + ) + + # replace renderPlot to avoid actual plotting, replace with renderText so we + # can simply check the output + testthat::local_mocked_bindings( + "renderPlot" = shiny::renderText, + .package = "shiny" + ) + + sample_data <- tibble::tibble(x = 1, y = 2) + + # act + shiny::testServer( + mod_plot_rates_trend_server, + args = list( + rates = \() sample_data, + y_axis_limits = \() c(0, 100), + y_axis_title = \() "Y Axis", + y_labels = \() "Y Labels", + selected_year = \() 202324 + ), + { + actual <- output$rates_trend_plot + + # assert + expect_equal(actual, "plot") + + expect_called(m, 1) + expect_args(m, 1, sample_data, 202324, c(0, 100), "Y Axis", "Y Labels") + } + ) +}) From cc3b867644231e9b8cf2df7dbddbe079563484c0 Mon Sep 17 00:00:00 2001 From: Tom Jemmett Date: Tue, 3 Feb 2026 09:39:54 +0000 Subject: [PATCH 11/47] adds tests for mod_select_geography --- R/mod_select_geography.R | 18 +++--------- tests/testthat/_snaps/mod_select_geography.md | 14 +++++++++ tests/testthat/test-mod_select_geography.R | 29 +++++++++++++++++++ 3 files changed, 47 insertions(+), 14 deletions(-) create mode 100644 tests/testthat/_snaps/mod_select_geography.md create mode 100644 tests/testthat/test-mod_select_geography.R diff --git a/R/mod_select_geography.R b/R/mod_select_geography.R index 2223aee..4784ded 100644 --- a/R/mod_select_geography.R +++ b/R/mod_select_geography.R @@ -6,7 +6,10 @@ mod_select_geography_ui <- function(id) { shiny::selectInput( ns("geography_select"), "Filter by geography:", - choices = NULL + choices = c( + "NHS provider trusts" = "nhp", + "Local authorities (LAs)" = "la" + ) ) } @@ -14,20 +17,7 @@ mod_select_geography_ui <- function(id) { #' @param id Internal parameter for `shiny`. #' @noRd mod_select_geography_server <- function(id) { - geographies <- c( - "NHS provider trusts" = "nhp", - "Local authorities (LAs)" = "la" - ) - shiny::moduleServer(id, function(input, output, session) { - shiny::observe({ - shiny::req(geographies) - shiny::updateSelectInput( - session, - "geography_select", - choices = geographies - ) - }) shiny::reactive(input$geography_select) }) } diff --git a/tests/testthat/_snaps/mod_select_geography.md b/tests/testthat/_snaps/mod_select_geography.md new file mode 100644 index 0000000..221ffd4 --- /dev/null +++ b/tests/testthat/_snaps/mod_select_geography.md @@ -0,0 +1,14 @@ +# ui + + Code + ui + Output +
+ +
+ + +
+
+ diff --git a/tests/testthat/test-mod_select_geography.R b/tests/testthat/test-mod_select_geography.R new file mode 100644 index 0000000..49ca567 --- /dev/null +++ b/tests/testthat/test-mod_select_geography.R @@ -0,0 +1,29 @@ +library(mockery) +library(testthat) + +test_that("ui", { + testthat::local_mocked_bindings( + "p_randomInt" = \(...) "X", + .package = "shiny" + ) + + ui <- mod_select_geography_ui("test") + + expect_snapshot(ui) +}) + +test_that("server returns reactive", { + # arrange + test_server <- function(input, output, session) { + selected_geography <- mod_select_geography_server("test") + } + + # act + shiny::testServer(test_server, { + session$setInputs("test-geography_select" = "nhp") + expect_equal(selected_geography(), "nhp") + + session$setInputs("test-geography_select" = "la") + expect_equal(selected_geography(), "la") + }) +}) From 851d4aa97cf79a1867fce207626d3ab9b5973f9d Mon Sep 17 00:00:00 2001 From: Tom Jemmett Date: Tue, 3 Feb 2026 12:41:10 +0000 Subject: [PATCH 12/47] adds tests for mod_select_provider --- tests/testthat/_snaps/mod_select_provider.md | 13 ++ tests/testthat/test-mod_select_provider.R | 128 +++++++++++++++++++ 2 files changed, 141 insertions(+) create mode 100644 tests/testthat/_snaps/mod_select_provider.md create mode 100644 tests/testthat/test-mod_select_provider.R diff --git a/tests/testthat/_snaps/mod_select_provider.md b/tests/testthat/_snaps/mod_select_provider.md new file mode 100644 index 0000000..3d8e8df --- /dev/null +++ b/tests/testthat/_snaps/mod_select_provider.md @@ -0,0 +1,13 @@ +# ui + + Code + ui + Output +
+ +
+ + +
+
+ diff --git a/tests/testthat/test-mod_select_provider.R b/tests/testthat/test-mod_select_provider.R new file mode 100644 index 0000000..5c83b7a --- /dev/null +++ b/tests/testthat/test-mod_select_provider.R @@ -0,0 +1,128 @@ +library(mockery) +library(testthat) + +test_that("ui", { + testthat::local_mocked_bindings( + "p_randomInt" = \(...) "X", + .package = "shiny" + ) + + ui <- mod_select_provider_ui("test") + + expect_snapshot(ui) +}) + +test_that("server returns reactive", { + # arrange + test_server <- function(input, output, session) { + selected_provider <- mod_select_provider_server("test", reactiveVal("nhp")) + } + + # act + shiny::testServer(test_server, { + session$setInputs("test-provider_select" = "a") + expect_equal(selected_provider(), "a") + + session$setInputs("test-provider_select" = "b") + expect_equal(selected_provider(), "b") + }) +}) + +test_that("providers reactive", { + # arrange + m <- mock("providers nhp", "providers la") + + testthat::local_mocked_bindings( + "read_json" = m, + .package = "jsonlite" + ) + testthat::local_mocked_bindings( + "app_sys" = \(...) file.path("inst", ...), + ) + + # act + shiny::testServer( + mod_select_provider_server, + args = list( + selected_geography = reactiveVal() + ), + { + # assert + selected_geography("nhp") + expect_equal(providers(), "providers nhp") + + selected_geography("la") + expect_equal(providers(), "providers la") + + selected_geography("other") + expect_error(providers()) + + expect_called(m, 2) + expect_args( + m, + 1, + "inst/app/data/nhp-datasets.json", + simplify_vector = TRUE + ) + expect_args( + m, + 2, + "inst/app/data/la-datasets.json", + simplify_vector = TRUE + ) + } + ) +}) + + +test_that("it updates the select input", { + # arrange + m <- mock() + testthat::local_mocked_bindings( + "updateSelectInput" = m, + .package = "shiny" + ) + + # mock what will happen to providers as we change the selected geography + testthat::local_mocked_bindings( + "read_json" = mock( + list("A" = "a", "B" = "b"), + list("C" = "c", "D" = "d") + ), + .package = "jsonlite" + ) + + # act + shiny::testServer( + mod_select_provider_server, + args = list( + selected_geography = reactiveVal() + ), + { + # assert + selected_geography("nhp") + session$private$flush() + expect_called(m, 1) + expect_args( + m, + 1, + session, + "provider_select", + label = "Choose a trust:", + choices = c("a" = "A", "b" = "B") + ) + + selected_geography("la") + session$private$flush() + expect_called(m, 2) + expect_args( + m, + 2, + session, + "provider_select", + label = "Choose an LA:", + choices = c("c" = "C", "d" = "D") + ) + } + ) +}) From 31a8b62c416da98dd20a3eb9927def3d8929afd2 Mon Sep 17 00:00:00 2001 From: Tom Jemmett Date: Tue, 3 Feb 2026 12:41:24 +0000 Subject: [PATCH 13/47] separates app_ui tests --- tests/testthat/test-app_ui.R | 99 ++++++++++++++++++++++++++++++++++-- 1 file changed, 96 insertions(+), 3 deletions(-) diff --git a/tests/testthat/test-app_ui.R b/tests/testthat/test-app_ui.R index 19e452f..b3dd166 100644 --- a/tests/testthat/test-app_ui.R +++ b/tests/testthat/test-app_ui.R @@ -1,9 +1,10 @@ library(mockery) -test_that("ui", { +setup_app_ui_tests <- function(.env = parent.frame()) { testthat::local_mocked_bindings( "p_randomInt" = \(...) "X", - .package = "shiny" + .package = "shiny", + .env = .env ) mocks <- list( @@ -18,36 +19,128 @@ test_that("ui", { "mod_select_strategy_ui" = mock("mod_select_strategy") ) - do.call(testthat::local_mocked_bindings, c(mocks)) + do.call(testthat::local_mocked_bindings, c(mocks, .env = .env)) + + mocks +} + +test_that("ui", { + # arrange + setup_app_ui_tests() + # act ui <- app_ui("request") + # assert expect_snapshot(ui) +}) + +test_that("calls mod_show_strategy_text_ui", { + # arrange + mocks <- setup_app_ui_tests() + # act + ui <- app_ui("request") + + # assert expect_called(mocks$mod_show_strategy_text_ui, 1) expect_args(mocks$mod_show_strategy_text_ui, 1, "mod_show_strategy_text") +}) +test_that("calls mod_plot_rates_ui", { + # arrange + mocks <- setup_app_ui_tests() + + # act + ui <- app_ui("request") + + # assert expect_called(mocks$mod_plot_rates_ui, 1) expect_args(mocks$mod_plot_rates_ui, 1, "mod_plot_rates") +}) + +test_that("calls mod_table_procedures_ui", { + # arrange + mocks <- setup_app_ui_tests() + + # act + ui <- app_ui("request") + # assert expect_called(mocks$mod_table_procedures_ui, 1) expect_args(mocks$mod_table_procedures_ui, 1, "mod_table_procedures") +}) + + +test_that("calls mod_table_diagnoses_ui", { + # arrange + mocks <- setup_app_ui_tests() + + # act + ui <- app_ui("request") + # assert expect_called(mocks$mod_table_diagnoses_ui, 1) expect_args(mocks$mod_table_diagnoses_ui, 1, "mod_table_diagnoses") +}) + + +test_that("calls mod_plot_age_sex_pyramid", { + # arrange + mocks <- setup_app_ui_tests() + # act + ui <- app_ui("request") + + # assert expect_called(mocks$mod_plot_age_sex_pyramid_ui, 1) expect_args(mocks$mod_plot_age_sex_pyramid_ui, 1, "mod_plot_age_sex_pyramid") +}) +test_that("calls mod_plot_nee_ui", { + # arrange + mocks <- setup_app_ui_tests() + + # act + ui <- app_ui("request") + + # assert expect_called(mocks$mod_plot_nee_ui, 1) expect_args(mocks$mod_plot_nee_ui, 1, "mod_plot_nee") +}) + +test_that("calls mod_select_geography_ui", { + # arrange + mocks <- setup_app_ui_tests() + # act + ui <- app_ui("request") + + # assert expect_called(mocks$mod_select_geography_ui, 1) expect_args(mocks$mod_select_geography_ui, 1, "mod_select_geography") +}) + +test_that("calls mod_select_provider_ui", { + # arrange + mocks <- setup_app_ui_tests() + + # act + ui <- app_ui("request") + # assert expect_called(mocks$mod_select_provider_ui, 1) expect_args(mocks$mod_select_provider_ui, 1, "mod_select_provider") +}) + +test_that("calls mod_select_strategy_ui", { + # arrange + mocks <- setup_app_ui_tests() + + # act + ui <- app_ui("request") + # assert expect_called(mocks$mod_select_strategy_ui, 1) expect_args(mocks$mod_select_strategy_ui, 1, "mod_select_strategy") }) From b5a7ec1cdfd924c6a93a4345ab33905a84026c2e Mon Sep 17 00:00:00 2001 From: Tom Jemmett Date: Tue, 3 Feb 2026 12:41:36 +0000 Subject: [PATCH 14/47] adds setup script --- tests/testthat/setup.R | 6 ++++++ 1 file changed, 6 insertions(+) create mode 100644 tests/testthat/setup.R diff --git a/tests/testthat/setup.R b/tests/testthat/setup.R new file mode 100644 index 0000000..73c27be --- /dev/null +++ b/tests/testthat/setup.R @@ -0,0 +1,6 @@ +options( + shiny.launch.browser = FALSE, + shiny.testmode = TRUE +) + +Sys.setenv(TESTTHAT_PARALLEL = "false") From 8d2b6a364ff25610dc05d66fc85aaf14573f0620 Mon Sep 17 00:00:00 2001 From: Tom Jemmett Date: Tue, 3 Feb 2026 12:41:47 +0000 Subject: [PATCH 15/47] adds tests for mod_select_strategy --- R/mod_select_strategy.R | 50 +++--- tests/testthat/_snaps/mod_select_strategy.md | 22 +++ tests/testthat/test-mod_select_strategy.R | 166 +++++++++++++++++++ 3 files changed, 213 insertions(+), 25 deletions(-) create mode 100644 tests/testthat/_snaps/mod_select_strategy.md create mode 100644 tests/testthat/test-mod_select_strategy.R diff --git a/R/mod_select_strategy.R b/R/mod_select_strategy.R index 3e7b4f6..4b472ad 100644 --- a/R/mod_select_strategy.R +++ b/R/mod_select_strategy.R @@ -21,47 +21,47 @@ mod_select_strategy_ui <- function(id) { ) } +mod_select_strategy_get_strategies <- function() { + strategies <- jsonlite::read_json( + app_sys("app", "data", "mitigators.json"), + simplify_vector = TRUE + ) + + strategies |> + unlist() |> + tibble::enframe("strategy", "name") |> + dplyr::mutate( + category = stringr::str_extract( + .data$name, + "(?<= \\()(IP|OP|AE)(?=-(AA|EF))" # e.g. 'IP' in 'IP-AA-001' + ) |> + stringr::str_to_lower() + ) |> + dplyr::nest_by(.data$category) |> + tibble::deframe() +} + #' Select Strategy Server #' @param id Internal parameter for `shiny`. #' @noRd mod_select_strategy_server <- function(id) { # load static data items - strategies <- jsonlite::read_json( - app_sys("app", "data", "mitigators.json"), - simplify_vector = TRUE - ) + strategies <- mod_select_strategy_get_strategies() # return the shiny module shiny::moduleServer(id, function(input, output, session) { - shiny::req(strategies) - - select_category <- shiny::reactive({ + selected_category <- shiny::reactive({ shiny::req(input$strategy_category_select) input$strategy_category_select }) shiny::observe({ - shiny::req(select_category()) + category <- shiny::req(selected_category()) - category_strategies <- strategies |> - unlist() |> - tibble::enframe("strategy", "name") |> - dplyr::mutate( - category = stringr::str_extract( - .data$name, - "(?<= \\()(IP|OP|AE)(?=-(AA|EF))" # e.g. 'IP' in 'IP-AA-001' - ) |> - stringr::str_to_lower() - ) |> - dplyr::filter(.data$category == select_category()) |> - dplyr::select("strategy", "name") |> + strategy_choices <- strategies[[category]] |> + dplyr::select("name", "strategy") |> tibble::deframe() - strategy_choices <- purrr::set_names( - names(category_strategies), - category_strategies - ) - shiny::updateSelectInput( session, "strategy_select", diff --git a/tests/testthat/_snaps/mod_select_strategy.md b/tests/testthat/_snaps/mod_select_strategy.md new file mode 100644 index 0000000..453b61f --- /dev/null +++ b/tests/testthat/_snaps/mod_select_strategy.md @@ -0,0 +1,22 @@ +# ui + + Code + ui + Output +
+ +
+ + +
+
+
+ +
+ + +
+
+ diff --git a/tests/testthat/test-mod_select_strategy.R b/tests/testthat/test-mod_select_strategy.R new file mode 100644 index 0000000..1bcabf7 --- /dev/null +++ b/tests/testthat/test-mod_select_strategy.R @@ -0,0 +1,166 @@ +library(mockery) +library(testthat) + +setup_mod_select_strategy_server <- function(.env = parent.frame()) { + strategies <- list( + ip = tibble::tibble( + name = c("Strategy A", "Strategy B"), + strategy = c("a", "b") + ), + op = tibble::tibble( + name = c("Strategy C", "Strategy D"), + strategy = c("c", "d") + ), + ae = tibble::tibble( + name = c("Strategy E", "Strategy F"), + strategy = c("e", "f") + ) + ) + m <- mock(strategies) + + local_mocked_bindings( + "mod_select_strategy_get_strategies" = m, + .env = .env + ) + + m +} + +test_that("ui", { + testthat::local_mocked_bindings( + "p_randomInt" = \(...) "X", + .package = "shiny" + ) + + ui <- mod_select_strategy_ui("test") + + expect_snapshot(ui) +}) + + +test_that("mod_select_strategy_get_strategies works", { + # arrange + m <- mock( + list( + "a" = "Strategy A (IP-AA-001)", + "b" = "Strategy B (IP-AA-002)", + "c" = "Strategy C (IP-EF-001)", + "d" = "Strategy D (OP-AA-001)", + "e" = "Strategy E (OP-AA-002)" + ) + ) + local_mocked_bindings( + "read_json" = m, + .package = "jsonlite" + ) + expected <- list( + "ip" = tibble::tribble( + ~strategy , ~name , + "a" , "Strategy A (IP-AA-001)" , + "b" , "Strategy B (IP-AA-002)" , + "c" , "Strategy C (IP-EF-001)" + ), + op = tibble::tribble( + ~strategy , ~name , + "d" , "Strategy D (OP-AA-001)" , + "e" , "Strategy E (OP-AA-002)" + ) + ) |> + dplyr::bind_rows(.id = "category") |> + dplyr::group_nest(.data$category) |> + tibble::deframe() + + # act + actual <- mod_select_strategy_get_strategies() + + # assert + expect_equal(actual, expected) + expect_called(m, 1) + expect_call( + m, + 1, + jsonlite::read_json( + app_sys("app", "data", "mitigators.json"), + simplify_vector = TRUE + ) + ) +}) + +test_that("server returns reactive", { + # arrange + setup_mod_select_strategy_server() + + test_server <- function(input, output, session) { + selected_strategy <- mod_select_strategy_server("test") + } + + # act + shiny::testServer(test_server, { + session$setInputs("test-strategy_select" = "a") + expect_equal(selected_strategy(), "a") + + session$setInputs("test-strategy_select" = "b") + expect_equal(selected_strategy(), "b") + }) +}) + +test_that("it calls mod_select_strategy_get_strategies", { + # arrange + m <- setup_mod_select_strategy_server() + + # act + shiny::testServer(mod_select_strategy_server, { + # assert + expect_called(m, 1) + expect_args(m, 1) + }) +}) + +test_that("selected_category", { + # arrange + setup_mod_select_strategy_server() + + # act + shiny::testServer(mod_select_strategy_server, { + session$setInputs("strategy_category_select" = "ip") + actual <- selected_category() + + # assert + expect_equal(actual, "ip") + }) +}) + +test_that("it updates the strategy_select choices", { + # arrange + setup_mod_select_strategy_server() + m <- mock() + local_mocked_bindings( + "updateSelectInput" = m, + .package = "shiny" + ) + + # act + shiny::testServer(mod_select_strategy_server, { + # assert + session$setInputs("strategy_category_select" = "ip") + expect_called(m, 1) + expect_args( + m, + 1, + session, + "strategy_select", + choices = c("Strategy A" = "a", "Strategy B" = "b") + ) + + # assert + session$setInputs("strategy_category_select" = "op") + expect_called(m, 2) + expect_args( + m, + 2, + session, + "strategy_select", + choices = c("Strategy C" = "c", "Strategy D" = "d") + ) + }) +}) From 57e3b43543ebe678faafb5bff79fd0bbad5633b7 Mon Sep 17 00:00:00 2001 From: Tom Jemmett Date: Tue, 3 Feb 2026 12:56:04 +0000 Subject: [PATCH 16/47] adds tests for mod_show_strategy_text --- .../testthat/_snaps/mod_show_strategy_text.md | 21 +++ tests/testthat/test-mod_show_strategy_text.R | 123 ++++++++++++++++++ 2 files changed, 144 insertions(+) create mode 100644 tests/testthat/_snaps/mod_show_strategy_text.md create mode 100644 tests/testthat/test-mod_show_strategy_text.R diff --git a/tests/testthat/_snaps/mod_show_strategy_text.md b/tests/testthat/_snaps/mod_show_strategy_text.md new file mode 100644 index 0000000..5752362 --- /dev/null +++ b/tests/testthat/_snaps/mod_show_strategy_text.md @@ -0,0 +1,21 @@ +# ui + + Code + ui + Output +
+
+
Description
+
+ +
+ +
+
+ diff --git a/tests/testthat/test-mod_show_strategy_text.R b/tests/testthat/test-mod_show_strategy_text.R new file mode 100644 index 0000000..ff1a2e1 --- /dev/null +++ b/tests/testthat/test-mod_show_strategy_text.R @@ -0,0 +1,123 @@ +library(mockery) +library(testthat) + +test_that("ui", { + testthat::local_mocked_bindings( + "p_randomInt" = \(...) "X", + .package = "shiny" + ) + + ui <- mod_show_strategy_text_ui("test") + + expect_snapshot(ui) +}) + +test_that("server loads descriptions lookup", { + # arrange + m <- mock("descriptions_lookup") + local_mocked_bindings( + "read_json" = m, + .package = "jsonlite" + ) + + # act + shiny::testServer(mod_show_strategy_text_server, { + # assert + expect_called(m, 1) + expect_call( + m, + 1, + jsonlite::read_json( + app_sys("app", "data", "descriptions.json"), + simplifyVector = TRUE + ) + ) + }) +}) + +test_that("strategy_text is rendered", { + # arrange + local_mocked_bindings( + "read_json" = \(...) "descriptions_lookup", + .package = "jsonlite" + ) + + m1 <- mock("strategy text") + m2 <- mock("html") + + local_mocked_bindings( + "fetch_strategy_text" = m1, + "convert_md_to_html" = m2 + ) + + # act + shiny::testServer( + mod_show_strategy_text_server, + args = list(selected_strategy = reactiveVal("a")), + { + # assert + actual <- output$strategy_text + + expect_equal(actual, "html") + + expect_called(m1, 1) + expect_args( + m1, + 1, + "a", + "descriptions_lookup" + ) + + expect_called(m2, 1) + expect_args(m2, 1, "strategy text") + } + ) +}) + +test_that("strategy_text caches properly", { + # arrange + local_mocked_bindings( + "read_json" = \(...) "descriptions_lookup", + .package = "jsonlite" + ) + + m1 <- mock("t1", "t2", "t3") + m2 <- mock("h1", "h2", "h3") + + local_mocked_bindings( + "fetch_strategy_text" = m1, + "convert_md_to_html" = m2 + ) + + # act + shiny::testServer( + mod_show_strategy_text_server, + args = list(selected_strategy = reactiveVal()), + { + # assert + selected_strategy("a") + session$private$flush() + a1 <- output$strategy_text + + selected_strategy("b") + session$private$flush() + a2 <- output$strategy_text + + selected_strategy("a") + session$private$flush() + a3 <- output$strategy_text + + expect_equal(a1, "h1") + expect_equal(a2, "h2") + expect_equal(a3, "h1") + + expect_called(m1, 2) + expect_args(m1, 1, "a", "descriptions_lookup") + expect_args(m1, 2, "b", "descriptions_lookup") + + expect_called(m2, 2) + expect_args(m2, 1, "t1") + expect_args(m2, 2, "t2") + } + ) +}) From 0c0cad770087729975bfeddd2bcc4401fd15e738 Mon Sep 17 00:00:00 2001 From: Tom Jemmett Date: Tue, 3 Feb 2026 14:56:14 +0000 Subject: [PATCH 17/47] adds tests for mod_table_diagnoses/procedures --- tests/testthat/_snaps/mod_table_diagnoses.md | 35 ++++ tests/testthat/_snaps/mod_table_procedures.md | 35 ++++ tests/testthat/test-mod_table_diagnoses.R | 164 ++++++++++++++++++ tests/testthat/test-mod_table_procedures.R | 164 ++++++++++++++++++ 4 files changed, 398 insertions(+) create mode 100644 tests/testthat/_snaps/mod_table_diagnoses.md create mode 100644 tests/testthat/_snaps/mod_table_procedures.md create mode 100644 tests/testthat/test-mod_table_diagnoses.R create mode 100644 tests/testthat/test-mod_table_procedures.R diff --git a/tests/testthat/_snaps/mod_table_diagnoses.md b/tests/testthat/_snaps/mod_table_diagnoses.md new file mode 100644 index 0000000..e59479f --- /dev/null +++ b/tests/testthat/_snaps/mod_table_diagnoses.md @@ -0,0 +1,35 @@ +# ui + + Code + ui + Output +
+
+
+ Diagnoses summary + + + + +
+
+ +
+ + + + + +
+
+ diff --git a/tests/testthat/_snaps/mod_table_procedures.md b/tests/testthat/_snaps/mod_table_procedures.md new file mode 100644 index 0000000..a435570 --- /dev/null +++ b/tests/testthat/_snaps/mod_table_procedures.md @@ -0,0 +1,35 @@ +# ui + + Code + ui + Output +
+
+
+ Procedures summary + + + + +
+
+ +
+ + + + + +
+
+ diff --git a/tests/testthat/test-mod_table_diagnoses.R b/tests/testthat/test-mod_table_diagnoses.R new file mode 100644 index 0000000..642d27a --- /dev/null +++ b/tests/testthat/test-mod_table_diagnoses.R @@ -0,0 +1,164 @@ +library(mockery) +library(testthat) + +test_that("ui", { + testthat::local_mocked_bindings( + "p_randomInt" = \(...) "X", + .package = "shiny" + ) + + ui <- mod_table_diagnoses_ui("test") + + expect_snapshot(ui) +}) + +test_that("it loads the diagnoses csv", { + # arrange + m <- mock("diagnoses_lookup") + testthat::local_mocked_bindings("read_csv" = m, .package = "readr") + + # act + shiny::testServer( + mod_table_diagnoses_server, + args = list( + inputs_data = reactiveVal(), + selected_provider = reactiveVal("R00"), + selected_strategy = reactiveVal("strategy"), + selected_year = reactiveVal(1) + ), + { + # assert + expect_equal(diagnoses_lookup, "diagnoses_lookup") + expect_called(m, 1) + expect_call( + m, + 1, + readr::read_csv( + app_sys("app", "data", "diagnoses.csv"), + col_types = "c" + ) + ) + } + ) +}) + +test_that("diagnoses_data", { + # arrange + sample_inputs_data = list( + diagnoses = "diagnoses" + ) + + # act + shiny::testServer( + mod_table_diagnoses_server, + args = list( + inputs_data = reactiveVal(sample_inputs_data), + selected_provider = reactiveVal("R00"), + selected_strategy = reactiveVal("strategy"), + selected_year = reactiveVal(1) + ), + { + actual <- diagnoses_data() + + # assert + expect_equal(actual, "diagnoses") + } + ) +}) + + +test_that("diagnoses_prepared", { + # arrange + sample_inputs_data <- list( + diagnoses = "diagnoses" + ) + + testthat::local_mocked_bindings( + "read_csv" = \(...) "diagnoses_lookup", + .package = "readr" + ) + + m <- mock("diagnoses_prepared") + testthat::local_mocked_bindings( + "prepare_diagnoses_data" = m + ) + + # act + shiny::testServer( + mod_table_diagnoses_server, + args = list( + inputs_data = reactiveVal(sample_inputs_data), + selected_provider = reactiveVal("R00"), + selected_strategy = reactiveVal("strategy"), + selected_year = reactiveVal(1) + ), + { + actual <- diagnoses_prepared() + + # assert + expect_equal(actual, "diagnoses_prepared") + expect_called(m, 1) + expect_args(m, 1, "diagnoses", "diagnoses_lookup", "R00", "strategy", 1) + } + ) +}) + +test_that("diagnoses_table (no rows)", { + # arrange + testthat::local_mocked_bindings("prepare_diagnoses_data" = \(...) { + tibble::tibble() + }) + + # act + shiny::testServer( + mod_table_diagnoses_server, + args = list( + inputs_data = reactiveVal(list(diagnoses = "diagnoses")), + selected_provider = reactiveVal("R00"), + selected_strategy = reactiveVal("strategy"), + selected_year = reactiveVal(1) + ), + { + # assert + expect_error( + output$diagnoses_table, + "No diagnoses to display." + ) + } + ) +}) + +test_that("diagnoses_table (with rows)", { + # arrange + sample_prepared_data <- tibble::tibble(a = 1, b = 2) + + m <- mock("entabled") + testthat::local_mocked_bindings( + "prepare_diagnoses_data" = \(...) sample_prepared_data, + "entable_encounters" = m + ) + + testthat::local_mocked_bindings( + "render_gt" = shiny::renderText, + .package = "gt" + ) + + # act + shiny::testServer( + mod_table_diagnoses_server, + args = list( + inputs_data = reactiveVal(list(diagnoses = "diagnoses")), + selected_provider = reactiveVal("R00"), + selected_strategy = reactiveVal("strategy"), + selected_year = reactiveVal(1) + ), + { + actual <- output$diagnoses_table + + # assert + expect_equal(actual, "entabled") + expect_called(m, 1) + expect_args(m, 1, sample_prepared_data) + } + ) +}) diff --git a/tests/testthat/test-mod_table_procedures.R b/tests/testthat/test-mod_table_procedures.R new file mode 100644 index 0000000..446b40f --- /dev/null +++ b/tests/testthat/test-mod_table_procedures.R @@ -0,0 +1,164 @@ +library(mockery) +library(testthat) + +test_that("ui", { + testthat::local_mocked_bindings( + "p_randomInt" = \(...) "X", + .package = "shiny" + ) + + ui <- mod_table_procedures_ui("test") + + expect_snapshot(ui) +}) + +test_that("it loads the procedures csv", { + # arrange + m <- mock("procedures_lookup") + testthat::local_mocked_bindings("read_csv" = m, .package = "readr") + + # act + shiny::testServer( + mod_table_procedures_server, + args = list( + inputs_data = reactiveVal(), + selected_provider = reactiveVal("R00"), + selected_strategy = reactiveVal("strategy"), + selected_year = reactiveVal(1) + ), + { + # assert + expect_equal(procedures_lookup, "procedures_lookup") + expect_called(m, 1) + expect_call( + m, + 1, + readr::read_csv( + app_sys("app", "data", "procedures.csv"), + col_types = "c" + ) + ) + } + ) +}) + +test_that("procedures_data", { + # arrange + sample_inputs_data = list( + procedures = "procedures" + ) + + # act + shiny::testServer( + mod_table_procedures_server, + args = list( + inputs_data = reactiveVal(sample_inputs_data), + selected_provider = reactiveVal("R00"), + selected_strategy = reactiveVal("strategy"), + selected_year = reactiveVal(1) + ), + { + actual <- procedures_data() + + # assert + expect_equal(actual, "procedures") + } + ) +}) + + +test_that("procedures_prepared", { + # arrange + sample_inputs_data <- list( + procedures = "procedures" + ) + + testthat::local_mocked_bindings( + "read_csv" = \(...) "procedures_lookup", + .package = "readr" + ) + + m <- mock("procedures_prepared") + testthat::local_mocked_bindings( + "prepare_procedures_data" = m + ) + + # act + shiny::testServer( + mod_table_procedures_server, + args = list( + inputs_data = reactiveVal(sample_inputs_data), + selected_provider = reactiveVal("R00"), + selected_strategy = reactiveVal("strategy"), + selected_year = reactiveVal(1) + ), + { + actual <- procedures_prepared() + + # assert + expect_equal(actual, "procedures_prepared") + expect_called(m, 1) + expect_args(m, 1, "procedures", "procedures_lookup", "R00", "strategy", 1) + } + ) +}) + +test_that("procedures_table (no rows)", { + # arrange + testthat::local_mocked_bindings("prepare_procedures_data" = \(...) { + tibble::tibble() + }) + + # act + shiny::testServer( + mod_table_procedures_server, + args = list( + inputs_data = reactiveVal(list(procedures = "procedures")), + selected_provider = reactiveVal("R00"), + selected_strategy = reactiveVal("strategy"), + selected_year = reactiveVal(1) + ), + { + # assert + expect_error( + output$procedures_table, + "No procedures to display." + ) + } + ) +}) + +test_that("procedures_table (with rows)", { + # arrange + sample_prepared_data <- tibble::tibble(a = 1, b = 2) + + m <- mock("entabled") + testthat::local_mocked_bindings( + "prepare_procedures_data" = \(...) sample_prepared_data, + "entable_encounters" = m + ) + + testthat::local_mocked_bindings( + "render_gt" = shiny::renderText, + .package = "gt" + ) + + # act + shiny::testServer( + mod_table_procedures_server, + args = list( + inputs_data = reactiveVal(list(procedures = "procedures")), + selected_provider = reactiveVal("R00"), + selected_strategy = reactiveVal("strategy"), + selected_year = reactiveVal(1) + ), + { + actual <- output$procedures_table + + # assert + expect_equal(actual, "entabled") + expect_called(m, 1) + expect_args(m, 1, sample_prepared_data) + } + ) +}) From 0ec1656e02283633270e22dad9fdce3999cab19a Mon Sep 17 00:00:00 2001 From: Tom Jemmett Date: Tue, 3 Feb 2026 15:11:30 +0000 Subject: [PATCH 18/47] adds test for run_app --- tests/testthat/test-run_app.R | 40 +++++++++++++++++++++++++++++++++++ 1 file changed, 40 insertions(+) create mode 100644 tests/testthat/test-run_app.R diff --git a/tests/testthat/test-run_app.R b/tests/testthat/test-run_app.R new file mode 100644 index 0000000..da1de9b --- /dev/null +++ b/tests/testthat/test-run_app.R @@ -0,0 +1,40 @@ +library(mockery) +library(testthat) + +test_that("run_app", { + # arrange + m1 <- mock() + m2 <- mock("app") + m3 <- mock("cache") + + local_mocked_bindings( + "shinyOptions" = m1, + "shinyApp" = m2, + .package = "shiny" + ) + local_mocked_bindings( + "cache_disk" = m3, + .package = "cachem" + ) + + # act + app <- run_app() + + # assert + expect_equal(app, "app") + + expect_called(m1, 1) + expect_args(m1, 1, cache = "cache") + + expect_called(m2, 1) + expect_args( + m2, + 1, + ui = app_ui, + server = app_server, + enableBookmarking = "server" + ) + + expect_called(m3, 1) + expect_args(m3, 1, ".cache") +}) From 31f849ddd2a17b4dec2754e2aca67ba48aa76f55 Mon Sep 17 00:00:00 2001 From: Tom Jemmett Date: Wed, 4 Feb 2026 10:09:48 +0000 Subject: [PATCH 19/47] adds tests for utils_data --- tests/testthat/test-utils_data.R | 131 +++++++++++++++++++++++++++++++ 1 file changed, 131 insertions(+) create mode 100644 tests/testthat/test-utils_data.R diff --git a/tests/testthat/test-utils_data.R b/tests/testthat/test-utils_data.R new file mode 100644 index 0000000..9c21133 --- /dev/null +++ b/tests/testthat/test-utils_data.R @@ -0,0 +1,131 @@ +library(mockery) +library(testthat) + +test_that("prepare_age_sex_data", { + # arrange + age_sex_data <- tibble::tribble( + ~age_group , ~sex , ~n , + "0-4" , 1 , 5 , + "5-9" , 1 , 10 , + "10-14" , 1 , 20 , + "0-4" , 2 , 7 , + "5-9" , 2 , 12 , + "10-14" , 2 , 22 , + ) + expected <- structure( + list( + age_group = structure( + c(1L, 3L, 2L, 1L, 3L, 2L), + levels = c("0-4", "10-14", "5-9"), + class = "factor" + ), + sex = structure( + c(1L, 1L, 1L, 2L, 2L, 2L), + levels = c("Males", "Females"), + class = "factor" + ), + n = c(-5, -10, -20, 7, 12, 22) + ), + row.names = c(NA, -6L), + class = c("tbl_df", "tbl", "data.frame") + ) + + # act + actual <- prepare_age_sex_data(age_sex_data) + + # assert + expect_equal(actual, expected) +}) + +test_that("get_golem_config", { + # arrange + m <- mock("config") + local_mocked_bindings( + "get" = m, + .package = "config" + ) + + local_mocked_bindings( + "app_sys" = \(...) file.path(...) + ) + + # act + actual <- get_golem_config("value", "config") + + # assert + expect_equal(actual, "config") + + expect_called(m, 1) + expect_args( + m, + 1, + value = "value", + config = "config", + file = "golem-config.yml", + use_parent = TRUE + ) +}) + +test_that("make_strategy_group_lookup", { + # arrange + config <- list( + "a" = list( + strategy_subset = c("s1" = "S1", "s2" = "S2") + ), + b = list( + strategy_subset = c("s3" = "S3") + ) + ) + expected <- tibble::tribble( + ~group , ~strategy , + "a" , "s1" , + "a" , "s2" , + "b" , "s3" + ) + + # act + actual <- make_strategy_group_lookup(config) + + # assert + expect_equal(actual, expected) +}) + +test_that("md_file_to_html returns NULL if file doesn't exist", { + # act + actual <- md_file_to_html("nonexistent_file.md") + + # assert + expect_null(actual) +}) + +test_that("md_file_to_html reads valid file", { + # arrange + local_mocked_bindings( + "app_sys" = \(...) file.path(...) + ) + + stub(md_file_to_html, "file.exists", TRUE) + + m1 <- mock("content") + m2 <- mock("html") + local_mocked_bindings( + "mark_html" = m1, + .package = "markdown" + ) + local_mocked_bindings( + "HTML" = m2, + .package = "shiny" + ) + + # act + actual <- md_file_to_html("file.md") + + # assert + expect_equal(actual, "html") + + expect_called(m1, 1) + expect_args(m1, 1, "file.md", output = FALSE, template = FALSE) + + expect_called(m2, 1) + expect_args(m2, 1, "content") +}) From a5f385bf8afb620f7f775038b7f9978c05b66a93 Mon Sep 17 00:00:00 2001 From: Tom Jemmett Date: Wed, 4 Feb 2026 10:10:54 +0000 Subject: [PATCH 20/47] adds tests for add_external_resources --- R/add_external_resources.R | 27 ++++++++++---------- tests/testthat/test-add_external_resources.R | 16 ++++++++++++ 2 files changed, 30 insertions(+), 13 deletions(-) create mode 100644 tests/testthat/test-add_external_resources.R diff --git a/R/add_external_resources.R b/R/add_external_resources.R index 5003741..afa4040 100644 --- a/R/add_external_resources.R +++ b/R/add_external_resources.R @@ -1,16 +1,17 @@ -#' Add External Resources to the Application -#' This function is internally used to add external resources inside the Shiny -#' application. -#' @noRd -add_external_resources <- function() { - shiny::addResourcePath( - "www", - app_sys("app/www") - ) - shiny::singleton( - shiny::tags$head() - ) -} +# TODO: should we remove this? It's not used anywhere. +# #' Add External Resources to the Application +# #' This function is internally used to add external resources inside the Shiny +# #' application. +# #' @noRd +# add_external_resources <- function() { +# shiny::addResourcePath( +# "www", +# app_sys("app/www") +# ) +# shiny::singleton( +# shiny::tags$head() +# ) +# } #' Access Files in the Current App #' @param ... Character vectors, specifying subdirectory and file(s) diff --git a/tests/testthat/test-add_external_resources.R b/tests/testthat/test-add_external_resources.R new file mode 100644 index 0000000..2510092 --- /dev/null +++ b/tests/testthat/test-add_external_resources.R @@ -0,0 +1,16 @@ +library(mockery) +library(testthat) + +test_that("app_sys", { + # arrange + m <- mock("path/to/file") + stub(app_sys, "system.file", m) + + # act + actual <- app_sys("subdir", "file.txt") + + # assert + expect_equal(actual, "path/to/file") + expect_called(m, 1) + expect_args(m, 1, "subdir", "file.txt", package = "tpma.explorer") +}) From 51aef7a817e69b316c7d84848ec597e885dd4cd8 Mon Sep 17 00:00:00 2001 From: Tom Jemmett Date: Wed, 4 Feb 2026 10:11:55 +0000 Subject: [PATCH 21/47] adds tests for utils_plot --- tests/testthat/test-utils_plot.R | 111 +++++++++++++++++++++++++++++++ 1 file changed, 111 insertions(+) create mode 100644 tests/testthat/test-utils_plot.R diff --git a/tests/testthat/test-utils_plot.R b/tests/testthat/test-utils_plot.R new file mode 100644 index 0000000..673461a --- /dev/null +++ b/tests/testthat/test-utils_plot.R @@ -0,0 +1,111 @@ +library(mockery) +library(testthat) + +test_that("isolate_provider_peers", { + # arrange + peers <- tibble::tribble( + ~procode , ~peer , + "A" , "B" , + "A" , "C" , + "B" , "A" , + "B" , "C" + ) + expected <- c("B", "C") + + # act + actual <- isolate_provider_peers("A", peers) + + # assert + expect_equal(actual, expected) +}) + +test_that("generate_rates_baseline_data", { + # arrange + rates <- tibble::tribble( + ~provider , ~strategy , ~fyear , + "A" , "S1" , 202223 , + "B" , "S1" , 202223 , + "C" , "S1" , 202223 , + "D" , "S1" , 202223 , + "A" , "S1" , 202324 , + "B" , "S1" , 202324 , + "C" , "S1" , 202324 , + "D" , "S1" , 202324 , + + "A" , "S2" , 202223 , + "B" , "S2" , 202223 , + "C" , "S2" , 202223 , + "D" , "S2" , 202223 , + "A" , "S2" , 202324 , + "B" , "S2" , 202324 , + "C" , "S2" , 202324 , + "D" , "S2" , 202324 , + ) + provider <- "A" + peers <- c("B", "C") + strategy <- "S1" + selected_year <- 202324 + + expected <- tibble::tribble( + ~provider , ~strategy , ~fyear , ~is_peer , + "B" , "S1" , 202324 , TRUE , + "C" , "S1" , 202324 , TRUE , + "A" , "S1" , 202324 , FALSE , + "D" , "S1" , 202324 , NA + ) + + # act + actual <- generate_rates_baseline_data( + rates, + provider, + peers, + strategy, + selected_year + ) + + # assert + expect_equal(actual, expected) +}) + +test_that("uprime_calculations", { + # arrange + df <- tibble::tribble( + ~denominator , ~rate , ~national_rate , + 1000 , 2.0 , 1.9 , + 2000 , 1.5 , 1.9 , + 1500 , 2.5 , 1.9 , + 2500 , 1.8 , 1.9 + ) + + # act + actual <- uprime_calculations(df) + + # assert + expect_equal(actual$cl, 1.9) + expect_equal( + actual$z_i, + c(0.1444332, 1.0613633, -0.8170378, -0.2283690), + tolerance = 1e-6 + ) + + expect_equal( + actual$lcl3(c(1000, 1500)), + c(-0.1770841, 0.2040680), + tolerance = 1e-6 + ) + expect_equal( + actual$lcl2(c(1000, 1500)), + c(0.5152773, 0.7693786), + tolerance = 1e-6 + ) + expect_equal( + actual$ucl2(c(1000, 1500)), + c(3.284723, 3.030621), + tolerance = 1e-6 + ) + expect_equal( + actual$ucl3(c(1000, 1500)), + c(3.977084, 3.595932), + tolerance = 1e-6 + ) +}) From 228175cb94dcf9fd2eef23643889d96db47b8d2b Mon Sep 17 00:00:00 2001 From: Tom Jemmett Date: Wed, 4 Feb 2026 10:12:22 +0000 Subject: [PATCH 22/47] updates snaps --- tests/testthat/_snaps/app_ui.md | 14 +++++++------- tests/testthat/_snaps/mod_plot_age_sex_pyramid.md | 6 +++--- tests/testthat/_snaps/mod_plot_nee.md | 6 +++--- tests/testthat/_snaps/mod_plot_rates_box.md | 6 +++--- tests/testthat/_snaps/mod_plot_rates_funnel.md | 6 +++--- tests/testthat/_snaps/mod_plot_rates_trend.md | 6 +++--- tests/testthat/_snaps/mod_show_strategy_text.md | 2 +- tests/testthat/_snaps/mod_table_diagnoses.md | 2 +- tests/testthat/_snaps/mod_table_procedures.md | 2 +- 9 files changed, 25 insertions(+), 25 deletions(-) diff --git a/tests/testthat/_snaps/app_ui.md b/tests/testthat/_snaps/app_ui.md index f77fae1..7bc4ef2 100644 --- a/tests/testthat/_snaps/app_ui.md +++ b/tests/testthat/_snaps/app_ui.md @@ -37,11 +37,11 @@
-
+
-
+
Warning @@ -79,7 +79,7 @@
-
Purpose
+
Purpose

View summaries of data for Types of Potentially-Mitigatable Activity (TPMAs) for statistical units within different geographical categories.

@@ -87,7 +87,7 @@
-
Definitions
+
Definitions

Visit the New Hospital Programme (NHP) project information website to:

-
Data
+
Data

Placeholder.

@@ -111,7 +111,7 @@
-
Navigation
+
Navigation

First, make selections in the left-hand panel:

  1. From the Visualisations section: @@ -139,7 +139,7 @@
-
Interface
+
Interface

You can hover over the information symbol () for further information about a visualisation.

To maximise the space for visualisations, you can:

    diff --git a/tests/testthat/_snaps/mod_plot_age_sex_pyramid.md b/tests/testthat/_snaps/mod_plot_age_sex_pyramid.md index 633f67c..533b4f9 100644 --- a/tests/testthat/_snaps/mod_plot_age_sex_pyramid.md +++ b/tests/testthat/_snaps/mod_plot_age_sex_pyramid.md @@ -5,7 +5,7 @@ Output
    -
    +
    Age-sex pyramid