Fixes failing "Add to Report" for modules that have DT table visualization (#900)

# Pull Request

<!--- Replace `#nnn` with your issue link for reference. -->

- Fixes #899
- Fixes #897 

### Changes description

- Use of `rtables::df_to_tt` to produce report tables (that are
decoratable)
- Update decorators documentation to reflect
- Minor code improvements that are marginally related (better variable
name to separate `data` (raw data frame) from `table` (rtable or DT))

---------

Signed-off-by: André Veríssimo <[email protected]>
Co-authored-by: github-actions <41898282+github-actions[bot]@users.noreply.github.com>

Author: averissimo

.lintr

@@ -1,6 +1,5 @@
 linters: linters_with_defaults(
   line_length_linter = line_length_linter(120),
-  cyclocomp_linter = NULL,
   object_usage_linter = NULL,
   object_name_linter = object_name_linter(styles = c("snake_case", "symbols"), regexes = c(ANL = "^ANL_?[0-9A-Z_]*$", ADaM = "^r?AD[A-Z]{2,3}_?[0-9]*$")),
   indentation_linter = NULL

NEWS.md

@@ -1,5 +1,14 @@
 # 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).
+
 # teal.modules.general 0.4.1
 
 ### Bug fixes

R/tm_g_bivariate.R

@@ -561,7 +561,7 @@ srv_g_bivariate <- function(id,
       datasets = data
     )
     qenv <- reactive(
-      teal.code::eval_code(data(), 'library("ggplot2");library("dplyr");library("teal.modules.general")') # nolint quotes
+      teal.code::eval_code(data(), 'library("ggplot2");library("dplyr")') # nolint: quotes.
     )
 
     anl_merged_q <- reactive({

R/tm_g_distribution.R

@@ -31,8 +31,6 @@
 #' This module generates the following objects, which can be modified in place using decorators::
 #' - `histogram_plot` (`ggplot`)
 #' - `qq_plot` (`ggplot`)
-#' - `summary_table` (`datatables` created with [DT::datatable()])
-#' - `test_table` (`datatables` created with [DT::datatable()])
 #'
 #' 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.
@@ -43,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
 #'    )
 #' )
 #' ```
@@ -194,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
 
@@ -322,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(
@@ -1284,24 +1271,31 @@ 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 <- DT::datatable(summary_table_data))
+        within(common_q(), {
+          summary_table <- rtables::df_to_tt(summary_table_data)
+          summary_table
+        })
       } else {
-        within(common_q(), summary_table <- DT::datatable(summary_table_data[0L, ]))
+        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
       test_q_out <- try(test_q(), silent = TRUE)
-      if (!inherits(test_q_out, c("try-error", "error"))) {
-        c(
+      if (inherits(test_q_out, c("try-error", "error"))) {
+        within(
           common_q(),
-          within(test_q_out, {
-            test_table <- DT::datatable(test_table_data)
-          })
+          test_table <- rtables::rtable(header = rtables::rheader("No data available in table"), rtables::rrow())
         )
       } else {
-        within(common_q(), test_table <- DT::datatable(data.frame(missing = character(0L))))
+        within(c(common_q(), test_q_out), {
+          test_table <- rtables::df_to_tt(test_table_data)
+          test_table
+        })
       }
     })
 
@@ -1319,54 +1313,47 @@ 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 <- if (inherits(test_q_out, c("try-error", "error"))) {
-        teal.code::qenv()
-      } else {
-        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"]],
-      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({
-      req(iv_r()$is_valid())
-      teal::validate_inputs(iv_r_dist())
-      req(test_q()) # Ensure original errors are displayed
-      decorated_output_test_q()[["test_table"]]
+      q <- req(output_test_q())
+
+      list(
+        html = DT::datatable(q[["test_table_data"]]),
+        report = q[["test_table"]]
+      )
     })
 
     pws1 <- teal.widgets::plot_with_settings_srv(
@@ -1385,7 +1372,7 @@ srv_distribution <- function(id,
       brushing = FALSE
     )
 
-    output$t_stats <- DT::renderDataTable(expr = tests_r())
+    output$t_stats <- DT::renderDataTable(tests_r()[["html"]])
 
     # Render R code.
     source_code_r <- reactive(teal.code::get_code(req(decorated_output_q())))
@@ -1412,11 +1399,11 @@ 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 (inherits(tests_error, "data.frame")) {
+        if (!identical(tests_error, "error")) {
           card$append_text("Tests table", "header3")
-          card$append_table(tests_r())
+          card$append_table(tests_r()[["report"]])
         }
 
         if (!comment == "") {

R/tm_missing_data.R

@@ -23,7 +23,6 @@
 #' - `summary_plot` (`grob` created with [ggplot2::ggplotGrob()])
 #' - `combination_plot` (`grob` created with [ggplot2::ggplotGrob()])
 #' - `by_subject_plot` (`ggplot`)
-#' - `table` (`datatables` created with [DT::datatable()])
 #'
 #' 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.
@@ -35,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
 #'    )
 #' )
 #' ```
@@ -148,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)) {
@@ -429,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(
@@ -1143,7 +1139,10 @@ srv_missing_data <- function(id,
         )
       }
 
-      within(qenv, table <- DT::datatable(summary_data))
+      within(qenv, {
+        table <- rtables::df_to_tt(summary_data)
+        table
+      })
     })
 
     by_subject_plot_q <- reactive({
@@ -1285,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,
@@ -1310,18 +1302,24 @@ srv_missing_data <- function(id,
     })
 
     summary_table_r <- reactive({
-      req(decorated_summary_table_q())
-
-      if (length(input$variables_select) == 0) {
-        # so that zeroRecords message gets printed
-        # using tibble as it supports weird column names, such as " "
-        DT::datatable(
-          tibble::tibble(` ` = logical(0)),
-          options = list(language = list(zeroRecords = "No variable selected."), pageLength = input$levels_table_rows)
-        )
-      } else {
-        decorated_summary_table_q()[["table"]]
-      }
+      q <- req(summary_table_q())
+
+      list(
+        html = if (length(input$variables_select) == 0) {
+          # so that zeroRecords message gets printed
+          # using tibble as it supports weird column names, such as " "
+          DT::datatable(
+            tibble::tibble(` ` = logical(0)),
+            options = list(
+              language = list(zeroRecords = "No variable selected."),
+              pageLength = input$levels_table_rows
+            )
+          )
+        } else {
+          DT::datatable(q[["summary_data"]])
+        },
+        report = q[["table"]]
+      )
     })
 
     by_subject_plot_r <- reactive({
@@ -1343,7 +1341,7 @@ srv_missing_data <- function(id,
       width = plot_width
     )
 
-    output$levels_table <- DT::renderDataTable(summary_table_r())
+    output$levels_table <- DT::renderDataTable(summary_table_r()[["html"]])
 
     pws3 <- teal.widgets::plot_with_settings_srv(
       id = "by_subject_plot",
@@ -1359,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()
       }
@@ -1397,11 +1395,10 @@ 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")
-          table <- decorated_summary_table_q()[["table"]]
-          if (nrow(table) == 0L) {
+          if (nrow(summary_table_q()[["summary_data"]]) == 0L) {
             card$append_text("No data available for table.")
           } else {
-            card$append_table(table)
+            card$append_table(summary_table_r()[["report"]])
           }
         } else if (sum_type == "Grouped by Subject") {
           card$append_text("Plot", "header3")