🗃️ 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/roxygen2_templates.R

@@ -0,0 +1,15 @@
+# nocov start
+roxygen_decorators_param <- function(module_name) {
+  paste(
+    sep = " ",
+    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.\n\n",
+    "Otherwise, the decorators are applied to all objects, which is equivalent as using the name `default`.\n\n",
+    sprintf("See section \"Decorating `%s`\"", module_name),
+    "below for more details."
+  )
+}
+# nocov start

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),
@@ -132,9 +131,18 @@ template_a_gee <- function(output_table,
 #' @inheritParams module_arguments
 #' @inheritParams template_arguments
 #' @inheritParams template_a_gee
+#' @param decorators `r roxygen_decorators_param("tm_a_gee")`
 #'
 #' @inherit module_arguments return seealso
 #'
+#' @section Decorating `tm_a_gee`:
+#'
+#' 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 +208,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 +227,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 +254,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 +370,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 +398,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,9 +560,15 @@ 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",
@@ -558,7 +578,7 @@ srv_gee <- function(id,
     # Render R code
     teal.widgets::verbatim_popup_srv(
       id = "rcode",
-      verbatim_content = reactive(teal.code::get_code(table_q())),
+      verbatim_content = reactive(teal.code::get_code(req(decorated_table_q()))),
       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(teal.code::get_code(req(decorated_table_q())))
         card
       }
       teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)

R/tm_g_barchart_simple.R

@@ -12,9 +12,18 @@
 #' @param x_facet (`data_extract_spec`)\cr row-wise faceting groups.
 #' @param y_facet (`data_extract_spec`)\cr column-wise faceting groups.
 #' @param plot_options (`list`)\cr list of plot options.
+#' @param decorators `r roxygen_decorators_param("tm_g_barchart_simple")`
 #'
 #' @inherit module_arguments return seealso
 #'
+#' @section Decorating `tm_g_barchart_simple`:
+#'
+#' This module generates the following objects, which can be modified in place using decorators:
+#' - `plot` (`ggplot2`)
+#'
+#' 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
@@ -146,7 +155,8 @@ tm_g_barchart_simple <- function(x = NULL,
                                  plot_width = NULL,
                                  pre_output = NULL,
                                  post_output = NULL,
-                                 ggplot2_args = teal.widgets::ggplot2_args()) {
+                                 ggplot2_args = teal.widgets::ggplot2_args(),
+                                 decorators = NULL) {
   message("Initializing tm_g_barchart_simple")
   checkmate::assert_string(label)
   checkmate::assert_list(plot_options, null.ok = TRUE)
@@ -171,6 +181,8 @@ tm_g_barchart_simple <- function(x = NULL,
   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(ggplot2_args, "ggplot2_args")
+  decorators <- normalize_decorators(decorators)
+  assert_decorators(decorators, names = "plot", null.ok = TRUE)
 
   plot_options <- utils::modifyList(
     list(stacked = FALSE), # default
@@ -190,7 +202,8 @@ tm_g_barchart_simple <- function(x = NULL,
       y_facet = y_facet,
       plot_height = plot_height,
       plot_width = plot_width,
-      ggplot2_args = ggplot2_args
+      ggplot2_args = ggplot2_args,
+      decorators = decorators
     ),
     datanames = "all"
   )
@@ -249,6 +262,7 @@ ui_g_barchart_simple <- function(id, ...) {
             is_single_dataset = is_single_dataset_value
           )
         },
+        ui_decorate_teal_data(ns("decorator"), decorators = select_decorators(args$decorators, "plot")),
         teal.widgets::panel_group(
           teal.widgets::panel_item(
             "Additional plot settings",
@@ -336,7 +350,8 @@ srv_g_barchart_simple <- function(id,
                                   y_facet,
                                   plot_height,
                                   plot_width,
-                                  ggplot2_args) {
+                                  ggplot2_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")
@@ -506,13 +521,16 @@ srv_g_barchart_simple <- function(id,
           )
         )) %>%
         teal.code::eval_code(code = plot_call)
-
-      # explicitly calling print on the plot inside the qenv evaluates
-      # the ggplot call and therefore catches errors
-      teal.code::eval_code(all_q, code = quote(print(plot)))
     })
 
-    plot_r <- reactive(all_q()[["plot"]])
+    decorated_all_q_code <- srv_decorate_teal_data(
+      "decorator",
+      data = all_q,
+      decorators = select_decorators(decorators, "plot"),
+      expr = print(plot)
+    )
+
+    plot_r <- reactive(decorated_all_q_code()[["plot"]])
 
     output$table <- renderTable({
       req(iv_r()$is_valid())
@@ -550,7 +568,7 @@ srv_g_barchart_simple <- function(id,
 
     teal.widgets::verbatim_popup_srv(
       id = "rcode",
-      verbatim_content = reactive(teal.code::get_code(all_q())),
+      verbatim_content = reactive(teal.code::get_code(req(decorated_all_q_code()))),
       title = "Bar Chart"
     )
 
@@ -569,7 +587,7 @@ srv_g_barchart_simple <- function(id,
           card$append_text("Comment", "header3")
           card$append_text(comment)
         }
-        card$append_src(teal.code::get_code(all_q()))
+        card$append_src(teal.code::get_code(req(decorated_all_q_code())))
         card
       }
       teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)

R/tm_g_ci.R

@@ -171,8 +171,7 @@ template_g_ci <- function(dataname,
 
   substitute(
     expr = {
-      gg <- graph_expr
-      print(gg)
+      plot <- graph_expr
     },
     env = list(graph_expr = pipe_expr(graph_list, pipe_str = "+"))
   )
@@ -186,9 +185,18 @@ template_g_ci <- function(dataname,
 #' @inheritParams module_arguments
 #' @inheritParams template_g_ci
 #' @param color (`data_extract_spec`)\cr the group variable used to determine the plot colors, shapes, and line types.
+#' @param decorators `r roxygen_decorators_param("tm_g_ci")`
 #'
 #' @inherit module_arguments return seealso
 #'
+#' @section Decorating `tm_g_ci`:
+#'
+#' This module generates the following objects, which can be modified in place using decorators:
+#' - `plot` (`ggplot2`)
+#'
+#' 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
@@ -275,7 +283,8 @@ tm_g_ci <- function(label,
                     plot_width = NULL,
                     pre_output = NULL,
                     post_output = NULL,
-                    ggplot2_args = teal.widgets::ggplot2_args()) {
+                    ggplot2_args = teal.widgets::ggplot2_args(),
+                    decorators = NULL) {
   message("Initializing tm_g_ci")
   checkmate::assert_string(label)
   stat <- match.arg(stat)
@@ -293,6 +302,8 @@ tm_g_ci <- 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(ggplot2_args, "ggplot2_args")
+  decorators <- normalize_decorators(decorators)
+  assert_decorators(decorators, "plot", null.ok = TRUE)
 
   args <- as.list(environment())
 
@@ -306,7 +317,8 @@ tm_g_ci <- function(label,
       label = label,
       plot_height = plot_height,
       plot_width = plot_width,
-      ggplot2_args = ggplot2_args
+      ggplot2_args = ggplot2_args,
+      decorators = decorators
     ),
     ui = ui_g_ci,
     ui_args = args,
@@ -355,7 +367,8 @@ ui_g_ci <- function(id, ...) {
         label = "Statistic to use",
         choices = c("mean", "median"),
         selected = args$stat
-      )
+      ),
+      ui_decorate_teal_data(ns("decorator"), decorators = select_decorators(args$decorators, "plot"))
     ),
     forms = tagList(
       teal.widgets::verbatim_popup_ui(ns("rcode"), "Show R code")
@@ -376,7 +389,8 @@ srv_g_ci <- function(id,
                      label,
                      plot_height,
                      plot_width,
-                     ggplot2_args) {
+                     ggplot2_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")
@@ -466,11 +480,18 @@ srv_g_ci <- function(id,
       teal.code::eval_code(anl_q(), list_calls)
     })
 
-    plot_r <- reactive(all_q()[["gg"]])
+    decorated_plot_q <- srv_decorate_teal_data(
+      id = "decorator",
+      data = all_q,
+      decorators = select_decorators(decorators, "plot"),
+      expr = print(plot)
+    )
+    # Outputs to render.
+    plot_r <- reactive(decorated_plot_q()[["plot"]])
 
     teal.widgets::verbatim_popup_srv(
       id = "rcode",
-      verbatim_content = reactive(teal.code::get_code(all_q())),
+      verbatim_content = reactive(teal.code::get_code(req(decorated_plot_q()))),
       title = label
     )
 
@@ -497,7 +518,7 @@ srv_g_ci <- function(id,
           card$append_text("Comment", "header3")
           card$append_text(comment)
         }
-        card$append_src(teal.code::get_code(all_q()))
+        card$append_src(teal.code::get_code(req(decorated_plot_q())))
         card
       }
       teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)