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

NEWS.md

@@ -1,5 +1,9 @@
 # teal.modules.general 0.4.1.9014
 
+### 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.
+
 # 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,10 @@
 #' 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()])
+#' - `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.
@@ -1284,24 +1286,22 @@ 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))
       } 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(
-          common_q(),
-          within(test_q_out, {
-            test_table <- DT::datatable(test_table_data)
-          })
-        )
+      if (inherits(test_q_out, c("try-error", "error"))) {
+        within(common_q(), test_table <- rtables::rtable(header = rtables::rheader("No data available in table")))
       } 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))
       }
     })
 
@@ -1354,7 +1354,7 @@ srv_distribution <- function(id,
     qq_r <- reactive(req(decorated_output_qq_q())[["qq_plot"]])
 
     output$summary_table <- DT::renderDataTable(
-      expr = decorated_output_summary_q()[["summary_table"]],
+      expr = decorated_output_summary_q()[["summary_table_data"]],
       options = list(
         autoWidth = TRUE,
         columnDefs = list(list(width = "200px", targets = "_all"))
@@ -1366,7 +1366,7 @@ srv_distribution <- function(id,
       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"]]
+      decorated_output_test_q()[["test_table_data"]]
     })
 
     pws1 <- teal.widgets::plot_with_settings_srv(
@@ -1416,7 +1416,7 @@ srv_distribution <- function(id,
         tests_error <- tryCatch(expr = tests_r(), error = function(e) "error")
         if (inherits(tests_error, "data.frame")) {
           card$append_text("Tests table", "header3")
-          card$append_table(tests_r())
+          card$append_table(decorated_output_test_q()[["test_table"]])
         }
 
         if (!comment == "") {

R/tm_missing_data.R

@@ -23,7 +23,8 @@
 #' - `summary_plot` (`grob` created with [ggplot2::ggplotGrob()])
 #' - `combination_plot` (`grob` created with [ggplot2::ggplotGrob()])
 #' - `by_subject_plot` (`ggplot`)
-#' - `table` (`datatables` created with [DT::datatable()])
+#' - `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.
@@ -1143,7 +1144,7 @@ srv_missing_data <- function(id,
         )
       }
 
-      within(qenv, table <- DT::datatable(summary_data))
+      within(qenv, table <- rtables::df_to_tt(summary_data))
     })
 
     by_subject_plot_q <- reactive({
@@ -1320,7 +1321,7 @@ srv_missing_data <- function(id,
           options = list(language = list(zeroRecords = "No variable selected."), pageLength = input$levels_table_rows)
         )
       } else {
-        decorated_summary_table_q()[["table"]]
+        decorated_summary_table_q()[["summary_data"]]
       }
     })
 
@@ -1397,11 +1398,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(decorated_summary_table_q()[["summary_data"]]) == 0L) {
             card$append_text("No data available for table.")
           } else {
-            card$append_table(table)
+            card$append_table(decorated_summary_table_q()[["table"]])
           }
         } else if (sum_type == "Grouped by Subject") {
           card$append_text("Plot", "header3")

R/tm_outliers.R

@@ -21,7 +21,8 @@
 #' - `box_plot` (`ggplot`)
 #' - `density_plot` (`ggplot`)
 #' - `cumulative_plot` (`ggplot`)
-#' - `table` (`datatables` created with [DT::datatable()])
+#' - `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.
@@ -661,7 +662,7 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var,
         qenv <- teal.code::eval_code(
           qenv,
           substitute(
-            expr = summary_table_pre <- ANL_OUTLIER %>%
+            expr = summary_data_pre <- ANL_OUTLIER %>%
               dplyr::filter(is_outlier_selected) %>%
               dplyr::select(outlier_var_name, categorical_var_name) %>%
               dplyr::group_by(categorical_var_name) %>%
@@ -706,9 +707,9 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var,
           qenv <- teal.code::eval_code(
             qenv,
             quote(
-              summary_table_pre <- summary_table_pre %>%
+              summary_data_pre <- summary_data_pre %>%
                 dplyr::arrange(desc(n_outliers / total_in_cat)) %>%
-                dplyr::mutate(order = seq_len(nrow(summary_table_pre)))
+                dplyr::mutate(order = seq_len(nrow(summary_data_pre)))
             )
           )
         }
@@ -722,17 +723,17 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var,
               # In this case, the column used for reordering is `order`.
               ANL_OUTLIER <- dplyr::left_join(
                 ANL_OUTLIER,
-                summary_table_pre[, c("order", categorical_var)],
+                summary_data_pre[, c("order", categorical_var)],
                 by = categorical_var
               )
               # so that x axis of plot aligns with columns of summary table, from most outliers to least by percentage
               ANL <- ANL %>%
                 dplyr::left_join(
-                  dplyr::select(summary_table_pre, categorical_var_name, order),
+                  dplyr::select(summary_data_pre, categorical_var_name, order),
                   by = categorical_var
                 ) %>%
                 dplyr::arrange(order)
-              summary_table <- summary_table_pre %>%
+              summary_data <- summary_data_pre %>%
                 dplyr::select(
                   categorical_var_name,
                   Outliers = display_str, Missings = display_str_na, Total = total_in_cat
@@ -749,20 +750,11 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var,
           )
         )
       } else {
-        within(qenv, summary_table <- data.frame())
+        within(qenv, summary_data <- data.frame())
       }
 
       # Generate decoratable object from data
-      qenv <- within(qenv, {
-        table <- DT::datatable(
-          summary_table,
-          options = list(
-            dom = "t",
-            autoWidth = TRUE,
-            columnDefs = list(list(width = "200px", targets = "_all"))
-          )
-        )
-      })
+      qenv <- within(qenv, table <- rtables::df_to_tt(summary_data))
 
       if (length(categorical_var) > 0 && nrow(qenv[["ANL_OUTLIER"]]) > 0) {
         shinyjs::show("order_by_outlier")
@@ -1080,10 +1072,15 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var,
         if (iv_r()$is_valid()) {
           categorical_var <- as.vector(merged$anl_input_r()$columns_source$categorical_var)
           if (!is.null(categorical_var)) {
-            decorated_final_q()[["table"]]
+            decorated_final_q()[["summary_data"]]
           }
         }
-      }
+      },
+      options = list(
+        dom = "t",
+        autoWidth = TRUE,
+        columnDefs = list(list(width = "200px", targets = "_all"))
+      )
     )
 
     # slider text
@@ -1355,9 +1352,8 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var,
         )
         categorical_var <- as.vector(merged$anl_input_r()$columns_source$categorical_var)
         if (length(categorical_var) > 0) {
-          summary_table <- decorated_final_q()[["table"]]
           card$append_text("Summary Table", "header3")
-          card$append_table(summary_table)
+          card$append_table(decorated_final_q()[["table"]])
         }
         card$append_text("Plot", "header3")
         if (tab_type == "Boxplot") {