From ca06d6d82549ec4b8b159d1e7ab672b4104dbe9d Mon Sep 17 00:00:00 2001 From: Milan Malfait <38256462+milanmlft@users.noreply.github.com> Date: Wed, 6 Nov 2024 17:57:39 +0000 Subject: [PATCH 1/3] Read summary data in only once instead of at every reactive call --- R/mod_plots.R | 22 ++++++++++++---------- tests/testthat/test-mod_plots.R | 9 ++++----- 2 files changed, 16 insertions(+), 15 deletions(-) diff --git a/R/mod_plots.R b/R/mod_plots.R index 024c51b..14a2849 100644 --- a/R/mod_plots.R +++ b/R/mod_plots.R @@ -48,37 +48,39 @@ mod_plots_server <- function(id, selected_concepts, selected_dates) { ) ) + summary_stats <- get_summary_stats() + monthly_counts <- get_monthly_counts() moduleServer(id, function(input, output, session) { selected_concept_ids <- reactive(selected_concepts()$concept_id) ## Filter data based on selected concept and date range - monthly_counts <- reactive({ + filtered_monthly_counts <- reactive({ req(length(selected_concept_ids()) > 0) req(selected_dates) - get_monthly_counts() |> + monthly_counts |> dplyr::filter(.data$concept_id %in% selected_concept_ids()) |> filter_dates(selected_dates()) }) - summary_stats <- reactive({ + filtered_summary_stats <- reactive({ req(length(selected_concept_ids()) > 0) - get_summary_stats() |> + summary_stats |> dplyr::filter(.data$concept_id %in% selected_concept_ids()) }) output$monthly_counts <- plotly::renderPlotly({ - req(nrow(monthly_counts()) > 0) - monthly_count_plot(monthly_counts()) + req(nrow(filtered_monthly_counts()) > 0) + monthly_count_plot(filtered_monthly_counts()) }) output$numeric_stats <- renderPlot({ - req(nrow(summary_stats()) > 0) - stat_numeric_plot(summary_stats()) + req(nrow(filtered_summary_stats()) > 0) + stat_numeric_plot(filtered_summary_stats()) }) output$categorical_stats <- renderPlot({ - req(nrow(summary_stats()) > 0) - stat_categorical_plot(summary_stats()) + req(nrow(filtered_summary_stats()) > 0) + stat_categorical_plot(filtered_summary_stats()) }) }) } diff --git a/tests/testthat/test-mod_plots.R b/tests/testthat/test-mod_plots.R index ed6ee15..c3351d3 100644 --- a/tests/testthat/test-mod_plots.R +++ b/tests/testthat/test-mod_plots.R @@ -14,12 +14,12 @@ test_that("mod_plots_server reacts to changes in the selected concept", { selected_row <- list(concept_id = 3003573L, concept_name = "test") mock_concept_row(selected_row) # update reactive value session$flushReact() - expect_identical(unique(summary_stats()$concept_id), selected_row$concept_id) + expect_identical(unique(filtered_summary_stats()$concept_id), selected_row$concept_id) selected_row2 <- list(concept_id = 4276526L, concept_name = "test") mock_concept_row(selected_row2) # update reactive value session$flushReact() - expect_identical(unique(summary_stats()$concept_id), selected_row2$concept_id) + expect_identical(unique(filtered_summary_stats()$concept_id), selected_row2$concept_id) } ) }) @@ -29,7 +29,6 @@ test_that("mod_plots_server reacts to changes in the selected date range", { mod_plots_server, args = list(selected_concepts = mock_concept_row, selected_dates = mock_date_range), { - ns <- session$ns expect_true(inherits(ns, "function")) expect_true(grepl(id, ns(""))) expect_true(grepl("test", ns("test"))) @@ -39,13 +38,13 @@ test_that("mod_plots_server reacts to changes in the selected date range", { selected_dates <- c("2019-01-01", "2019-12-31") mock_date_range(selected_dates) session$flushReact() - expect_true(all(monthly_counts()$date_year == 2019)) + expect_true(all(filtered_monthly_counts()$date_year == 2019)) ## Case when no data for given range selected_dates2 <- c("3019-01-01", "3019-12-31") mock_date_range(selected_dates2) session$flushReact() - expect_equal(nrow(monthly_counts()), 0) + expect_equal(nrow(filtered_monthly_counts()), 0) } ) }) From 0f88963a54a15855b7b284d8f74e74294267ecf0 Mon Sep 17 00:00:00 2001 From: Milan Malfait <38256462+milanmlft@users.noreply.github.com> Date: Wed, 6 Nov 2024 17:59:54 +0000 Subject: [PATCH 2/3] Remove duplicate stats with warning --- R/mod_plots.R | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/R/mod_plots.R b/R/mod_plots.R index 14a2849..8aa7cb9 100644 --- a/R/mod_plots.R +++ b/R/mod_plots.R @@ -50,6 +50,17 @@ mod_plots_server <- function(id, selected_concepts, selected_dates) { summary_stats <- get_summary_stats() monthly_counts <- get_monthly_counts() + + # Check for duplicated rows, potentially a problem with the source data + if (nrow(summary_stats) > dplyr::n_distinct(summary_stats)) { + cli::cli_warn(c( + "Duplicate rows detected in summary stats. Only keeping distinct rows.", + "i" = "This might point to a problem with the source data" + )) + summary_stats <- dplyr::distinct(summary_stats) + } + + moduleServer(id, function(input, output, session) { selected_concept_ids <- reactive(selected_concepts()$concept_id) From 129a7087b47c4031a83e161eb141de1283081ace Mon Sep 17 00:00:00 2001 From: Milan Malfait <38256462+milanmlft@users.noreply.github.com> Date: Thu, 7 Nov 2024 11:11:23 +0000 Subject: [PATCH 3/3] Fix accidental line deletion --- tests/testthat/test-mod_plots.R | 1 + 1 file changed, 1 insertion(+) diff --git a/tests/testthat/test-mod_plots.R b/tests/testthat/test-mod_plots.R index c3351d3..73e5e8a 100644 --- a/tests/testthat/test-mod_plots.R +++ b/tests/testthat/test-mod_plots.R @@ -29,6 +29,7 @@ test_that("mod_plots_server reacts to changes in the selected date range", { mod_plots_server, args = list(selected_concepts = mock_concept_row, selected_dates = mock_date_range), { + ns <- session$ns expect_true(inherits(ns, "function")) expect_true(grepl(id, ns(""))) expect_true(grepl("test", ns("test")))