Fixes failing "Add to Report" for modules that have DT table visualization

NEWS.md

@@ -1,8 +1,13 @@
 # teal.modules.general 0.4.1.9015
 
+### Breaking changes
+
+- Removed the `table` object decoration in `tm_missing_data` and `tm_outliers` (#899).
+- Removed the `summary_table` and `test_table` object decoration in `tm_g_distribution` (#897).
+
 ### Bug fixes
 
-- Fixes "Add to Report" functionality in `tm_outliers`, `tm_missing_data` and `tm_g_distribution` modules (#899 and #897). Table decorators in this modules use `rtables` as base object for decoration.
+- Fixes "Add to Report" functionality in `tm_outliers`, `tm_missing_data` and `tm_g_distribution` modules (#899 and #897).
 
 # teal.modules.general 0.4.1
 

R/tm_g_distribution.R

@@ -31,10 +31,6 @@
 #' This module generates the following objects, which can be modified in place using decorators::
 #' - `histogram_plot` (`ggplot`)
 #' - `qq_plot` (`ggplot`)
-#' - `summary_table` (`ElementaryTable` created with [rtables::df_to_tt()])
-#'   - The decorated table is only shown in the reporter as it is presented as an interactive `DataTable` in the module.
-#' - `test_table` (`ElementaryTable` created with [rtables::df_to_tt()])
-#'   - The decorated table is only shown in the reporter as it is presented as an interactive `DataTable` in the module.
 #'
 #' A Decorator is applied to the specific output using a named list of `teal_transform_module` objects.
 #' The name of this list corresponds to the name of the output to which the decorator is applied.
@@ -45,9 +41,7 @@
 #'    ..., # arguments for module
 #'    decorators = list(
 #'      histogram_plot = teal_transform_module(...), # applied only to `histogram_plot` output
-#'      qq_plot = teal_transform_module(...), # applied only to `qq_plot` output
-#'      summary_table = teal_transform_module(...), # applied only to `summary_table` output
-#'      test_table = teal_transform_module(...) # applied only to `test_table` output
+#'      qq_plot = teal_transform_module(...) # applied only to `qq_plot` output
 #'    )
 #' )
 #' ```
@@ -196,8 +190,7 @@ tm_g_distribution <- function(label = "Distribution Module",
   checkmate::assert_multi_class(pre_output, c("shiny.tag", "shiny.tag.list", "html"), null.ok = TRUE)
   checkmate::assert_multi_class(post_output, c("shiny.tag", "shiny.tag.list", "html"), null.ok = TRUE)
 
-  available_decorators <- c("histogram_plot", "qq_plot", "test_table", "summary_table")
-  assert_decorators(decorators, names = available_decorators)
+  assert_decorators(decorators, names = c("histogram_plot", "qq_plot"))
 
   # End of assertions
 
@@ -324,14 +317,6 @@ ui_distribution <- function(id, ...) {
             collapsed = FALSE
           )
         ),
-        ui_decorate_teal_data(
-          ns("d_summary"),
-          decorators = select_decorators(args$decorators, "summary_table")
-        ),
-        ui_decorate_teal_data(
-          ns("d_test"),
-          decorators = select_decorators(args$decorators, "test_table")
-        ),
         conditionalPanel(
           condition = paste0("input['", ns("main_type"), "'] == 'Density'"),
           bslib::accordion_panel(
@@ -1286,14 +1271,17 @@ srv_distribution <- function(id,
     # Summary table listing has to be created separately to allow for qenv join
     output_summary_q <- reactive({
       if (iv_r()$is_valid()) {
-        within(common_q(), summary_table <- rtables::df_to_tt(summary_table_data))
+        within(common_q(), {
+          summary_table <- rtables::df_to_tt(summary_table_data)
+          summary_table
+        })
       } else {
         within(
           common_q(),
           summary_table <- rtables::rtable(header = rtables::rheader(colnames(summary_table_data)))
         )
       }
-    })
+        })
 
     output_test_q <- reactive({
       # wrapped in if since could lead into validate error - we do want to continue
@@ -1304,7 +1292,10 @@ srv_distribution <- function(id,
           test_table <- rtables::rtable(header = rtables::rheader("No data available in table"), rtables::rrow())
         )
       } else {
-        within(c(common_q(), test_q_out), test_table <- rtables::df_to_tt(test_table_data))
+        within(c(common_q(), test_q_out), {
+          test_table <- rtables::df_to_tt(test_table_data)
+          test_table
+        })
       }
     })
 
@@ -1322,47 +1313,42 @@ srv_distribution <- function(id,
       expr = print(qq_plot)
     )
 
-    decorated_output_summary_q <- srv_decorate_teal_data(
-      "d_summary",
-      data = output_summary_q,
-      decorators = select_decorators(decorators, "summary_table"),
-      expr = summary_table
-    )
-
-    decorated_output_test_q <- srv_decorate_teal_data(
-      "d_test",
-      data = output_test_q,
-      decorators = select_decorators(decorators, "test_table"),
-      expr = test_table
-    )
-
     decorated_output_q <- reactive({
       tab <- req(input$tabs) # tab is NULL upon app launch, hence will crash without this statement
       test_q_out <- try(test_q(), silent = TRUE)
-      decorated_test_q_out <- decorated_output_test_q()
+      test_q_out <- output_test_q()
 
       out_q <- switch(tab,
         Histogram = decorated_output_dist_q(),
         QQplot = decorated_output_qq_q()
       )
-      c(out_q, decorated_output_summary_q(), decorated_test_q_out)
+      c(out_q, output_summary_q(), test_q_out)
     })
 
     dist_r <- reactive(req(decorated_output_dist_q())[["histogram_plot"]])
 
     qq_r <- reactive(req(decorated_output_qq_q())[["qq_plot"]])
 
-    output$summary_table <- DT::renderDataTable(
-      expr = decorated_output_summary_q()[["summary_table_data"]],
-      options = list(
-        autoWidth = TRUE,
-        columnDefs = list(list(width = "200px", targets = "_all"))
-      ),
-      rownames = FALSE
-    )
+    summary_r <- reactive({
+      q <- req(output_summary_q())
+
+      list(
+        html = DT::datatable(
+          q[["summary_table_data"]],
+          options = list(
+            autoWidth = TRUE,
+            columnDefs = list(list(width = "200px", targets = "_all"))
+          ),
+          rownames = FALSE
+        ),
+        report = q[["summary_table"]]
+      )
+    })
+
+    output$summary_table <- DT::renderDataTable(summary_r()[["html"]])
 
     tests_r <- reactive({
-      q <- req(decorated_output_test_q())
+      q <- req(output_test_q())
 
       list(
         html = DT::datatable(q[["test_table_data"]]),
@@ -1386,7 +1372,7 @@ srv_distribution <- function(id,
       brushing = FALSE
     )
 
-    output$t_stats <- DT::renderDataTable(expr = tests_r()[["html"]])
+    output$t_stats <- DT::renderDataTable(tests_r()[["html"]])
 
     # Render R code.
     source_code_r <- reactive(teal.code::get_code(req(decorated_output_q())))
@@ -1413,7 +1399,7 @@ srv_distribution <- function(id,
           card$append_plot(qq_r(), dim = pws2$dim())
         }
         card$append_text("Statistics table", "header3")
-        card$append_table(decorated_output_summary_q()[["summary_table"]])
+        card$append_table(summary_r()[["report"]])
         tests_error <- tryCatch(expr = tests_r(), error = function(e) "error")
         if (!identical(tests_error, "error")) {
           card$append_text("Tests table", "header3")

R/tm_missing_data.R

@@ -23,8 +23,6 @@
 #' - `summary_plot` (`grob` created with [ggplot2::ggplotGrob()])
 #' - `combination_plot` (`grob` created with [ggplot2::ggplotGrob()])
 #' - `by_subject_plot` (`ggplot`)
-#' - `table` (`ElementaryTable` created with [rtables::df_to_tt()])
-#'   - The decorated table is only shown in the reporter as it is presented as an interactive `DataTable` in the module.
 #'
 #' A Decorator is applied to the specific output using a named list of `teal_transform_module` objects.
 #' The name of this list corresponds to the name of the output to which the decorator is applied.
@@ -36,8 +34,7 @@
 #'    decorators = list(
 #'      summary_plot = teal_transform_module(...), # applied only to `summary_plot` output
 #'      combination_plot = teal_transform_module(...), # applied only to `combination_plot` output
-#'      by_subject_plot = teal_transform_module(...), # applied only to `by_subject_plot` output
-#'      table = teal_transform_module(...) # applied only to `table` output
+#'      by_subject_plot = teal_transform_module(...) # applied only to `by_subject_plot` output
 #'    )
 #' )
 #' ```
@@ -149,8 +146,7 @@ tm_missing_data <- function(label = "Missing data",
   checkmate::assert_multi_class(pre_output, c("shiny.tag", "shiny.tag.list", "html"), null.ok = TRUE)
   checkmate::assert_multi_class(post_output, c("shiny.tag", "shiny.tag.list", "html"), null.ok = TRUE)
 
-  available_decorators <- c("summary_plot", "combination_plot", "by_subject_plot", "table")
-  assert_decorators(decorators, names = available_decorators)
+  assert_decorators(decorators, names = c("summary_plot", "combination_plot", "by_subject_plot"))
   # End of assertions
 
   datanames_module <- if (identical(datanames, "all") || is.null(datanames)) {
@@ -430,8 +426,7 @@ encoding_missing_data <- function(id, summary_per_patient = FALSE, ggtheme, data
         choices = c("counts", "proportions"),
         selected = "counts",
         inline = TRUE
-      ),
-      ui_decorate_teal_data(ns("dec_summary_table"), decorators = select_decorators(decorators, "table"))
+      )
     ),
     bslib::accordion(
       bslib::accordion_panel(
@@ -1144,7 +1139,10 @@ srv_missing_data <- function(id,
         )
       }
 
-      within(qenv, table <- rtables::df_to_tt(summary_data))
+      within(qenv, {
+        table <- rtables::df_to_tt(summary_data)
+        table
+      })
     })
 
     by_subject_plot_q <- reactive({
@@ -1286,13 +1284,6 @@ srv_missing_data <- function(id,
       }
     )
 
-    decorated_summary_table_q <- srv_decorate_teal_data(
-      id = "dec_summary_table",
-      data = summary_table_q,
-      decorators = select_decorators(decorators, "table"),
-      expr = table
-    )
-
     decorated_by_subject_plot_q <- srv_decorate_teal_data(
       id = "dec_by_subject_plot",
       data = by_subject_plot_q,
@@ -1311,7 +1302,7 @@ srv_missing_data <- function(id,
     })
 
     summary_table_r <- reactive({
-      q <- req(decorated_summary_table_q())
+      q <- req(summary_table_q())
 
       list(
         html = if (length(input$variables_select) == 0) {
@@ -1366,7 +1357,7 @@ srv_missing_data <- function(id,
       } else if (sum_type == "Combinations") {
         decorated_combination_plot_q()
       } else if (sum_type == "By Variable Levels") {
-        decorated_summary_table_q()
+        summary_table_q()
       } else if (sum_type == "Grouped by Subject") {
         decorated_by_subject_plot_q()
       }
@@ -1404,7 +1395,7 @@ srv_missing_data <- function(id,
           card$append_plot(combination_plot_r(), dim = pws2$dim())
         } else if (sum_type == "By Variable Levels") {
           card$append_text("Table", "header3")
-          if (nrow(decorated_summary_table_q()[["summary_data"]]) == 0L) {
+          if (nrow(summary_table_q()[["summary_data"]]) == 0L) {
             card$append_text("No data available for table.")
           } else {
             card$append_table(summary_table_r()[["report"]])

R/tm_outliers.R

@@ -21,8 +21,6 @@
 #' - `box_plot` (`ggplot`)
 #' - `density_plot` (`ggplot`)
 #' - `cumulative_plot` (`ggplot`)
-#' - `table` (`ElementaryTable` created with [rtables::df_to_tt()])
-#'   - The decorated table is only shown in the reporter as it is presented as an interactive `DataTable` in the module.
 #'
 #' A Decorator is applied to the specific output using a named list of `teal_transform_module` objects.
 #' The name of this list corresponds to the name of the output to which the decorator is applied.
@@ -34,8 +32,7 @@
 #'    decorators = list(
 #'      box_plot = teal_transform_module(...), # applied only to `box_plot` output
 #'      density_plot = teal_transform_module(...), # applied only to `density_plot` output
-#'      cumulative_plot = teal_transform_module(...), # applied only to `cumulative_plot` output
-#'      table = teal_transform_module(...) # applied only to `table` output
+#'      cumulative_plot = teal_transform_module(...) # applied only to `cumulative_plot` output
 #'    )
 #' )
 #' ```
@@ -198,8 +195,7 @@ tm_outliers <- function(label = "Outliers Module",
   checkmate::assert_multi_class(pre_output, c("shiny.tag", "shiny.tag.list", "html"), null.ok = TRUE)
   checkmate::assert_multi_class(post_output, c("shiny.tag", "shiny.tag.list", "html"), null.ok = TRUE)
 
-  available_decorators <- c("box_plot", "density_plot", "cumulative_plot", "table")
-  assert_decorators(decorators, names = available_decorators)
+  assert_decorators(decorators, names = c("box_plot", "density_plot", "cumulative_plot"))
   # End of assertions
 
   # Make UI args
@@ -369,7 +365,6 @@ ui_outliers <- function(id, ...) {
           decorators = select_decorators(args$decorators, "cumulative_plot")
         )
       ),
-      ui_decorate_teal_data(ns("d_table"), decorators = select_decorators(args$decorators, "table")),
       bslib::accordion_panel(
         title = "Plot settings",
         selectInput(
@@ -754,7 +749,10 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var,
       }
 
       # Generate decoratable object from data
-      qenv <- within(qenv, table <- rtables::df_to_tt(summary_data))
+      qenv <- within(qenv, {
+        table <- rtables::df_to_tt(summary_data)
+        table
+      })
 
       if (length(categorical_var) > 0 && nrow(qenv[["ANL_OUTLIER"]]) > 0) {
         shinyjs::show("order_by_outlier")
@@ -1058,14 +1056,7 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var,
       c(box_plot_q, density_plot_q, cumulative_plot_q)
     )
 
-    decorated_final_q_no_table <- reactive(decorated_q[[req(current_tab_r())]]())
-
-    decorated_final_q <- srv_decorate_teal_data(
-      "d_table",
-      data = decorated_final_q_no_table,
-      decorators = select_decorators(decorators, "table"),
-      expr = table
-    )
+    decorated_final_q <- reactive(decorated_q[[req(current_tab_r())]]())
 
     summary_table_r <- reactive({
       q <- req(decorated_final_q())