370 again integration test failures because of snapshot changes (#371)

#370 This is a prototype to replace the plot snapshot testing and avoid test failure due to minimal changes in the plotting. - introduce a test argument in the barplot module. If `TRUE`, the structure (`layer_data`) of the plot is rendered. - the snapshot test is now performed on the underlying data rather than on the plot itself thank you for your review and suggestions --------- Co-authored-by: benoit <[email protected]>
insightsengineering · Mar 25, 2024 · e12820c · e12820c
1 parent 3c89b02
commit e12820c
Show file tree

Hide file tree

Showing 43 changed files with 958 additions and 139 deletions.
diff --git a/R/argument_convention.R b/R/argument_convention.R
@@ -43,6 +43,7 @@
 #' @param plot_width (`list`)\cr list of integers to set the default, minimum,
 #'   and maximum plot width.
 #' @param filter_panel_api (`FilterPanelAPI`)\cr object describing the actual filter panel API.
+#' @param .test (`flag`)\cr whether to display the internal structure of the plot for testing purposes.
 #'
 #' @name module_arguments
 #' @keywords internal

diff --git a/R/barplot.R b/R/barplot.R
@@ -34,29 +34,33 @@ tm_g_barplot <- function(label,
                            Max = matrixStats::colMaxs
                          ),
                          pre_output = NULL,
-                         post_output = NULL) {
+                         post_output = NULL,
+                         .test = FALSE) {
   message("Initializing tm_g_barplot")
   assert_string(label)
   assert_string(mae_name)
   assert_character(exclude_assays)
   assert_summary_funs(summary_funs)
   assert_tag(pre_output, null.ok = TRUE)
   assert_tag(post_output, null.ok = TRUE)
+  assert_flag(.test)
 
   module(
     label = label,
     server = srv_g_barplot,
     server_args = list(
       mae_name = mae_name,
       exclude_assays = exclude_assays,
-      summary_funs = summary_funs
+      summary_funs = summary_funs,
+      .test = .test
     ),
     ui = ui_g_barplot,
     ui_args = list(
       mae_name = mae_name,
       summary_funs = summary_funs,
       pre_output = pre_output,
-      post_output = post_output
+      post_output = post_output,
+      .test = .test
     ),
     datanames = mae_name
   )
@@ -69,7 +73,8 @@ ui_g_barplot <- function(id,
                          mae_name,
                          summary_funs,
                          pre_output,
-                         post_output) {
+                         post_output,
+                         .test = FALSE) {
   ns <- NS(id)
   teal.widgets::standard_layout(
     encoding = tags$div(
@@ -101,7 +106,10 @@ ui_g_barplot <- function(id,
         )
       )
     ),
-    output = teal.widgets::plot_with_settings_ui(ns("plot")),
+    output = div(
+      if (.test) verbatimTextOutput(ns("table")) else NULL,
+      teal.widgets::plot_with_settings_ui(ns("plot"))
+    ),
     pre_output = pre_output,
     post_output = post_output
   )
@@ -116,11 +124,13 @@ srv_g_barplot <- function(id,
                           reporter,
                           mae_name,
                           exclude_assays,
-                          summary_funs) {
+                          summary_funs,
+                          .test = FALSE) {
   with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
   assert_class(filter_panel_api, "FilterPanelAPI")
   checkmate::assert_class(data, "reactive")
   checkmate::assert_class(shiny::isolate(data()), "teal_data")
+  assert_flag(.test)
   moduleServer(id, function(input, output, session) {
     output$experiment_ui <- renderUI({
       experimentSpecInput(session$ns("experiment"), data, mae_name)
@@ -189,6 +199,13 @@ srv_g_barplot <- function(id,
       plot_r = plot_r
     )
 
+    if (.test) {
+      table_r <- reactive({
+        str(layer_data(plot_r()))
+      })
+      output$table <- renderPrint(table_r())
+    }
+
     ### REPORTER
     if (with_reporter) {
       card_fun <- function(comment, label) {
@@ -230,6 +247,7 @@ srv_g_barplot <- function(id,
           card$append_text("Comment", "header3")
           card$append_text(comment)
         }
+
         card
       }
       teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
@@ -246,14 +264,15 @@ srv_g_barplot <- function(id,
 #' if (interactive()) {
 #'   sample_tm_g_barplot()
 #' }
-sample_tm_g_barplot <- function() {
+sample_tm_g_barplot <- function(.test = FALSE) {
   data <- teal.data::teal_data(MAE = hermes::multi_assay_experiment)
   app <- teal::init(
     data = data,
     modules = teal::modules(
       tm_g_barplot(
         label = "barplot",
-        mae_name = "MAE"
+        mae_name = "MAE",
+        .test = .test
       )
     )
   )

diff --git a/R/boxplot.R b/R/boxplot.R
@@ -35,29 +35,33 @@ tm_g_boxplot <- function(label,
                            Max = matrixStats::colMaxs
                          ),
                          pre_output = NULL,
-                         post_output = NULL) {
+                         post_output = NULL,
+                         .test = FALSE) {
   message("Initializing tm_g_boxplot")
   assert_string(label)
   assert_string(mae_name)
   assert_character(exclude_assays, any.missing = FALSE)
   assert_summary_funs(summary_funs, null.ok = TRUE)
   assert_tag(pre_output, null.ok = TRUE)
   assert_tag(post_output, null.ok = TRUE)
+  assert_flag(.test)
 
   teal::module(
     label = label,
     server = srv_g_boxplot,
     server_args = list(
       mae_name = mae_name,
       summary_funs = summary_funs,
-      exclude_assays = exclude_assays
+      exclude_assays = exclude_assays,
+      .test = .test
     ),
     ui = ui_g_boxplot,
     ui_args = list(
       mae_name = mae_name,
       summary_funs = summary_funs,
       pre_output = pre_output,
-      post_output = post_output
+      post_output = post_output,
+      .test = .test
     ),
     datanames = mae_name
   )
@@ -70,7 +74,8 @@ ui_g_boxplot <- function(id,
                          mae_name,
                          summary_funs,
                          pre_output,
-                         post_output) {
+                         post_output,
+                         .test = FALSE) {
   ns <- NS(id)
   teal.widgets::standard_layout(
     encoding = tags$div(
@@ -97,7 +102,10 @@ ui_g_boxplot <- function(id,
         )
       )
     ),
-    output = teal.widgets::plot_with_settings_ui(ns("plot")),
+    output = div(
+      if (.test) verbatimTextOutput(ns("table")) else NULL,
+      teal.widgets::plot_with_settings_ui(ns("plot"))
+    ),
     pre_output = pre_output,
     post_output = post_output
   )
@@ -112,7 +120,8 @@ srv_g_boxplot <- function(id,
                           reporter,
                           mae_name,
                           exclude_assays,
-                          summary_funs) {
+                          summary_funs,
+                          .test = FALSE) {
   with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
   assert_class(filter_panel_api, "FilterPanelAPI")
   checkmate::assert_class(data, "reactive")
@@ -184,6 +193,13 @@ srv_g_boxplot <- function(id,
       plot_r = plot_r
     )
 
+    if (.test) {
+      table_r <- reactive({
+        str(layer_data(plot_r()))
+      })
+      output$table <- renderPrint(table_r())
+    }
+
     ### REPORTER
     if (with_reporter) {
       card_fun <- function(comment, label) {
@@ -247,14 +263,15 @@ srv_g_boxplot <- function(id,
 #' if (interactive()) {
 #'   sample_tm_g_boxplot()
 #' }
-sample_tm_g_boxplot <- function() {
+sample_tm_g_boxplot <- function(.test = FALSE) {
   data <- teal.data::teal_data(MAE = hermes::multi_assay_experiment)
   app <- teal::init(
     data = data,
     modules = teal::modules(
       tm_g_boxplot(
         label = "boxplot",
-        mae_name = "MAE"
+        mae_name = "MAE",
+        .test = .test
       )
     )
   )

diff --git a/R/forestplot.R b/R/forestplot.R
@@ -53,7 +53,8 @@ tm_g_forest_tte <- function(label,
                             pre_output = NULL,
                             post_output = NULL,
                             plot_height = c(600L, 200L, 2000L),
-                            plot_width = c(1360L, 500L, 2000L)) {
+                            plot_width = c(1360L, 500L, 2000L),
+                            .test = FALSE) {
   message("Initializing tm_g_forest_tte")
   assert_string(label)
   assert_string(adtte_name)
@@ -63,6 +64,7 @@ tm_g_forest_tte <- function(label,
   assert_summary_funs(summary_funs)
   assert_tag(pre_output, null.ok = TRUE)
   assert_tag(post_output, null.ok = TRUE)
+  assert_flag(.test)
 
   teal::module(
     label = label,
@@ -74,15 +76,17 @@ tm_g_forest_tte <- function(label,
       exclude_assays = exclude_assays,
       summary_funs = summary_funs,
       plot_height = plot_height,
-      plot_width = plot_width
+      plot_width = plot_width,
+      .test = .test
     ),
     ui = ui_g_forest_tte,
     ui_args = list(
       adtte_name = adtte_name,
       mae_name = mae_name,
       summary_funs = summary_funs,
       pre_output = pre_output,
-      post_output = post_output
+      post_output = post_output,
+      .test = .test
     ),
     datanames = c(adtte_name, mae_name)
   )
@@ -96,7 +100,8 @@ ui_g_forest_tte <- function(id,
                             mae_name,
                             summary_funs,
                             pre_output,
-                            post_output) {
+                            post_output,
+                            .test = FALSE) {
   ns <- NS(id)
   teal.widgets::standard_layout(
     encoding = tags$div(
@@ -120,7 +125,10 @@ ui_g_forest_tte <- function(id,
         )
       )
     ),
-    output = teal.widgets::plot_with_settings_ui(ns("plot")),
+    output = div(
+      if (.test) verbatimTextOutput(ns("table")) else NULL,
+      teal.widgets::plot_with_settings_ui(ns("plot"))
+    ),
     pre_output = pre_output,
     post_output = post_output
   )
@@ -139,7 +147,8 @@ srv_g_forest_tte <- function(id,
                              exclude_assays,
                              summary_funs,
                              plot_height,
-                             plot_width) {
+                             plot_width,
+                             .test = FALSE) {
   with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
   assert_class(filter_panel_api, "FilterPanelAPI")
   checkmate::assert_class(data, "reactive")
@@ -217,8 +226,8 @@ srv_g_forest_tte <- function(id,
     })
 
     forest_plot <- reactive({
-      result <- result()
-      tern::g_forest(result)
+      res <- result()
+      tern::g_forest(res)
     })
 
     pws <- teal.widgets::plot_with_settings_srv(
@@ -228,6 +237,13 @@ srv_g_forest_tte <- function(id,
       width = plot_width
     )
 
+    if (.test) {
+      table_r <- reactive({
+        rtables::as_result_df(result())
+      })
+      output$table <- renderPrint(table_r())
+    }
+
     ### REPORTER
     if (with_reporter) {
       card_fun <- function(comment, label) {
@@ -285,7 +301,7 @@ srv_g_forest_tte <- function(id,
 #' if (interactive()) {
 #'   sample_tm_g_forest_tte()
 #' }
-sample_tm_g_forest_tte <- function() { # nolint
+sample_tm_g_forest_tte <- function(.test = FALSE) { # nolint
   data <- teal_data()
   data <- within(data, {
     ADTTE <- teal.modules.hermes::rADTTE %>% # nolint
@@ -302,7 +318,8 @@ sample_tm_g_forest_tte <- function() { # nolint
       tm_g_forest_tte(
         label = "forest",
         adtte_name = "ADTTE",
-        mae_name = "MAE"
+        mae_name = "MAE",
+        .test = .test
       )
     )
   )