🗃️ Decorators feature branch

.pre-commit-config.yaml

@@ -33,7 +33,6 @@ repos:
           - methods
           - rlistings
           - rmarkdown
-          - rtables
           - scales
           - shiny
           - shinyjs
@@ -48,6 +47,9 @@ repos:
           - insightsengineering/teal.widgets
           - insightsengineering/tern.gee
           - insightsengineering/tern.mmrm
+          - insightsengineering/rtables
+          - insightsengineering/rtables.officer
+          - insightsengineering/formatters
           - utils
           - vistime
       - id: spell-check

R/argument_convention.R

@@ -203,6 +203,14 @@ NULL
 #'   value indicating worst grade.
 #' @param worst_flag_var ([teal.transform::choices_selected()])\cr object
 #'   with all available choices and preselected option for variable names that can be used as worst flag variable.
+#' @param decorators `r lifecycle::badge("experimental")`
+#' " (`list` of `teal_transform_module`, named `list` of `teal_transform_module` or" `NULL`) optional,
+#' if not `NULL`, decorator for tables or plots included in the module.
+#' When a named list of `teal_transform_module`, the decorators are applied to the respective output objects.
+#'
+#' Otherwise, the decorators are applied to all objects, which is equivalent as using the name `default`.
+#'
+#' See section "Decorating Module" below for more details.
 #'
 #' @return a `teal_module` object.
 #'

R/tm_a_gee.R

@@ -69,9 +69,9 @@ template_a_gee <- function(output_table,
       if (output_table == "t_gee_cov") {
         substitute(
           expr = {
-            result_table <- tern.gee::as.rtable(model_fit, type = "cov")
-            subtitles(result_table) <- st
-            main_footer(result_table) <- mf
+            table <- tern.gee::as.rtable(model_fit, type = "cov")
+            subtitles(table) <- st
+            main_footer(table) <- mf
           },
           env = list(
             st = basic_table_args$subtitles,
@@ -81,9 +81,9 @@ template_a_gee <- function(output_table,
       } else if (output_table == "t_gee_coef") {
         substitute(
           expr = {
-            result_table <- tern.gee::as.rtable(data.frame(Coefficient = model_fit$coefficients))
-            subtitles(result_table) <- st
-            main_footer(result_table) <- mf
+            table <- tern.gee::as.rtable(data.frame(Coefficient = model_fit$coefficients))
+            subtitles(table) <- st
+            main_footer(table) <- mf
           },
           env = list(
             conf_level = conf_level,
@@ -95,17 +95,16 @@ template_a_gee <- function(output_table,
         substitute(
           expr = {
             lsmeans_fit_model <- tern.gee::lsmeans(model_fit, conf_level)
-            result_table <- rtables::basic_table(show_colcounts = TRUE) %>%
+            table <- rtables::basic_table(show_colcounts = TRUE) %>%
               rtables::split_cols_by(var = input_arm_var, ref_group = model_fit$ref_level) %>%
               tern.gee::summarize_gee_logistic() %>%
               rtables::build_table(
                 df = lsmeans_fit_model,
                 alt_counts_df = dataname_lsmeans
               )
 
-            subtitles(result_table) <- st
-            main_footer(result_table) <- mf
-            result_table
+            subtitles(table) <- st
+            main_footer(table) <- mf
           },
           env = list(
             dataname_lsmeans = as.name(dataname_lsmeans),
@@ -135,6 +134,14 @@ template_a_gee <- function(output_table,
 #'
 #' @inherit module_arguments return seealso
 #'
+#' @section Decorating Module:
+#'
+#' 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.clinical)
 #' interactive <- function() TRUE
@@ -200,7 +207,8 @@ tm_a_gee <- function(label,
                      conf_level = teal.transform::choices_selected(c(0.95, 0.9, 0.8), 0.95, keep_order = 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_a_gee (prototype)")
 
   cov_var <- teal.transform::add_no_selected_choices(cov_var, multiple = TRUE)
@@ -218,6 +226,8 @@ tm_a_gee <- function(label,
   checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE)
   checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE)
   checkmate::assert_class(basic_table_args, "basic_table_args")
+  decorators <- normalize_decorators(decorators)
+  assert_decorators(decorators, "table", null.ok = TRUE)
 
   args <- as.list(environment())
 
@@ -243,7 +253,8 @@ tm_a_gee <- function(label,
         parentname = parentname,
         arm_ref_comp = arm_ref_comp,
         label = label,
-        basic_table_args = basic_table_args
+        basic_table_args = basic_table_args,
+        decorators = decorators
       )
     ),
     datanames = teal.transform::get_extract_datanames(data_extract_list)
@@ -358,7 +369,8 @@ ui_gee <- function(id, ...) {
           "Coefficients" = "t_gee_coef"
         ),
         selected = "t_gee_lsmeans"
-      )
+      ),
+      ui_decorate_teal_data(ns("decorator"), decorators = select_decorators(a$decorators, "table"))
     ),
     forms = tagList(
       teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code")
@@ -385,7 +397,8 @@ srv_gee <- function(id,
                     label,
                     plot_height,
                     plot_width,
-                    basic_table_args) {
+                    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")
@@ -546,19 +559,26 @@ srv_gee <- function(id,
       output_title
     })
 
-    table_r <- reactive({
-      table_q()[["result_table"]]
-    })
+    decorated_table_q <- srv_decorate_teal_data(
+      id = "decorator",
+      data = table_q,
+      decorators = select_decorators(decorators, "table"),
+      expr = table
+    )
+
+    # Outputs to render.
+    table_r <- reactive(decorated_table_q()[["table"]])
 
     teal.widgets::table_with_settings_srv(
       id = "table",
       table_r = table_r
     )
 
     # Render R code
+    source_code_r <- reactive(teal.code::get_code(req(decorated_table_q())))
     teal.widgets::verbatim_popup_srv(
       id = "rcode",
-      verbatim_content = reactive(teal.code::get_code(table_q())),
+      verbatim_content = source_code_r,
       title = label
     )
 
@@ -582,7 +602,7 @@ srv_gee <- function(id,
           card$append_text("Comment", "header3")
           card$append_text(comment)
         }
-        card$append_src(teal.code::get_code(table_q()))
+        card$append_src(source_code_r())
         card
       }
       teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)