Merge branch '1187_decorate_output@main' into tm_pca@1187_decorate_output@main

Author: averissimo

R/tm_t_crosstable.R

@@ -25,6 +25,14 @@
 #'
 #' @inherit shared_params return
 #'
+#' @section Decorating `tm_t_crosstable`:
+#'
+#' This module generates the following objects, which can be modified in place using decorators:
+#' - `table` (`ElementaryTable` - output of `rtables::build_table`)
+#'
+#' For additional details and examples of decorators, refer to the vignette
+#' `vignette("decorate-modules-output", package = "teal")` or the [`teal_transform_module()`] documentation.
+#'
 #' @examplesShinylive
 #' library(teal.modules.general)
 #' interactive <- function() TRUE
@@ -134,7 +142,8 @@ tm_t_crosstable <- function(label = "Cross Table",
                             show_total = TRUE,
                             pre_output = NULL,
                             post_output = NULL,
-                            basic_table_args = teal.widgets::basic_table_args()) {
+                            basic_table_args = teal.widgets::basic_table_args(),
+                            decorators = NULL) {
   message("Initializing tm_t_crosstable")
 
   # Requires Suggested packages
@@ -158,6 +167,7 @@ tm_t_crosstable <- function(label = "Cross Table",
   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)
   checkmate::assert_class(basic_table_args, classes = "basic_table_args")
+  checkmate::assert_list(decorators, "teal_transform_module", null.ok = TRUE)
   # End of assertions
 
   # Make UI args
@@ -167,7 +177,8 @@ tm_t_crosstable <- function(label = "Cross Table",
     label = label,
     x = x,
     y = y,
-    basic_table_args = basic_table_args
+    basic_table_args = basic_table_args,
+    decorators = decorators
   )
 
   ans <- module(
@@ -184,6 +195,7 @@ tm_t_crosstable <- function(label = "Cross Table",
 
 # UI function for the cross-table module
 ui_t_crosstable <- function(id, x, y, show_percentage, show_total, pre_output, post_output, ...) {
+  args <- list(...)
   ns <- NS(id)
   is_single_dataset <- teal.transform::is_single_dataset(x, y)
 
@@ -221,7 +233,8 @@ ui_t_crosstable <- function(id, x, y, show_percentage, show_total, pre_output, p
           checkboxInput(ns("show_percentage"), "Show column percentage", value = show_percentage),
           checkboxInput(ns("show_total"), "Show total column", value = show_total)
         )
-      )
+      ),
+      ui_teal_transform_data(ns("decorate"), transformators = args$decorators)
     ),
     forms = tagList(
       teal.widgets::verbatim_popup_ui(ns("rcode"), "Show R code")
@@ -232,7 +245,7 @@ ui_t_crosstable <- function(id, x, y, show_percentage, show_total, pre_output, p
 }
 
 # Server function for the cross-table module
-srv_t_crosstable <- function(id, data, reporter, filter_panel_api, label, x, y, basic_table_args) {
+srv_t_crosstable <- function(id, data, reporter, filter_panel_api, label, x, y, basic_table_args, decorators) {
   with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
   with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")
   checkmate::assert_class(data, "reactive")
@@ -351,7 +364,7 @@ srv_t_crosstable <- function(id, data, reporter, filter_panel_api, label, x, y,
         teal.code::eval_code(
           substitute(
             expr = {
-              lyt <- basic_tables %>%
+              table <- basic_tables %>%
                 split_call %>% # styler: off
                 rtables::add_colcounts() %>%
                 tern::analyze_vars(
@@ -387,19 +400,22 @@ srv_t_crosstable <- function(id, data, reporter, filter_panel_api, label, x, y,
           substitute(
             expr = {
               ANL <- tern::df_explicit_na(ANL)
-              tbl <- rtables::build_table(lyt = lyt, df = ANL[order(ANL[[y_name]]), ])
-              tbl
+              table <- rtables::build_table(lyt = table, df = ANL[order(ANL[[y_name]]), ])
             },
             env = list(y_name = y_name)
           )
         )
     })
 
+    decorated_output_q_no_print <- srv_teal_transform_data("decorate", data = output_q, transformators = decorators)
+    decorated_output_q <- reactive(within(decorated_output_q_no_print(), expr = table))
+
     output$title <- renderText(output_q()[["title"]])
 
     table_r <- reactive({
       req(iv_r()$is_valid())
-      output_q()[["tbl"]]
+      req(output_q())
+      decorated_output_q()[["table"]]
     })
 
     teal.widgets::table_with_settings_srv(
@@ -409,7 +425,7 @@ srv_t_crosstable <- function(id, data, reporter, filter_panel_api, label, x, y,
 
     teal.widgets::verbatim_popup_srv(
       id = "rcode",
-      verbatim_content = reactive(teal.code::get_code(output_q())),
+      verbatim_content = reactive(teal.code::get_code(req(decorated_output_q()))),
       title = "Show R Code for Cross-Table"
     )
 
@@ -428,7 +444,7 @@ srv_t_crosstable <- function(id, data, reporter, filter_panel_api, label, x, y,
           card$append_text("Comment", "header3")
           card$append_text(comment)
         }
-        card$append_src(teal.code::get_code(output_q()))
+        card$append_src(teal.code::get_code(req(decorated_output_q())))
         card
       }
       teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)