introduce decorators for tm_g_association

R/tm_g_association.R

@@ -25,6 +25,15 @@
 #'
 #' @inherit shared_params return
 #'
+#' @section Decorating `tm_g_association`:
+#'
+#' This module generates the following objects, which can be modified in place using decorators:
+#' - `plot_top` (`ggplot2`)
+#' - `plot_bottom` (`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.general)
 #' interactive <- function() TRUE
@@ -130,7 +139,8 @@ tm_g_association <- function(label = "Association",
                              association_theme = c("gray", "bw", "linedraw", "light", "dark", "minimal", "classic", "void"), # nolint: line_length.
                              pre_output = NULL,
                              post_output = NULL,
-                             ggplot2_args = teal.widgets::ggplot2_args()) {
+                             ggplot2_args = teal.widgets::ggplot2_args(),
+                             decorators = NULL) {
   message("Initializing tm_g_association")
 
   # Normalize the parameters
@@ -166,6 +176,7 @@ tm_g_association <- function(label = "Association",
   plot_choices <- c("Bivariate1", "Bivariate2")
   checkmate::assert_list(ggplot2_args, types = "ggplot2_args")
   checkmate::assert_subset(names(ggplot2_args), c("default", plot_choices))
+  checkmate::assert_list(decorators, "teal_transform_module", null.ok = TRUE)
   # End of assertions
 
   # Make UI args
@@ -183,7 +194,7 @@ tm_g_association <- function(label = "Association",
     ui_args = args,
     server_args = c(
       data_extract_list,
-      list(plot_height = plot_height, plot_width = plot_width, ggplot2_args = ggplot2_args)
+      list(plot_height = plot_height, plot_width = plot_width, ggplot2_args = ggplot2_args, decorators = decorators)
     ),
     datanames = teal.transform::get_extract_datanames(data_extract_list)
   )
@@ -236,6 +247,7 @@ ui_tm_g_association <- function(id, ...) {
         "Log transformed",
         value = FALSE
       ),
+      ui_transform_teal_data(ns("decorate"), transformators = args$decorators),
       teal.widgets::panel_group(
         teal.widgets::panel_item(
           title = "Plot settings",
@@ -277,7 +289,8 @@ srv_tm_g_association <- function(id,
                                  vars,
                                  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")
@@ -463,7 +476,6 @@ srv_tm_g_association <- function(id,
             )
           )
         }
-
       teal.code::eval_code(
         merged$anl_q_r(),
         substitute(
@@ -474,10 +486,8 @@ srv_tm_g_association <- function(id,
         teal.code::eval_code(
           substitute(
             expr = {
-              plots <- plot_calls
-              p <- tern::stack_grobs(grobs = lapply(plots, ggplotGrob))
-              grid::grid.newpage()
-              grid::grid.draw(p)
+              plot_top <- plot_calls[[1]]
+              plot_bottom <- plot_calls[[1]]
             },
             env = list(
               plot_calls = do.call(
@@ -490,9 +500,23 @@ srv_tm_g_association <- function(id,
         )
     })
 
+    decorated_output_q <- srv_transform_teal_data("decorate", data = output_q, transformators = decorators)
+    decorated_output_grob_q <- reactive({
+      within(
+        decorated_output_q(),
+        {
+          plot <- tern::stack_grobs(grobs = lapply(list(plot_top, plot_bottom), ggplotGrob))
+          grid::grid.newpage()
+          grid::grid.draw(plot)
+        }
+      )
+    })
+
+
     plot_r <- reactive({
       req(iv_r()$is_valid())
-      output_q()[["p"]]
+      req(output_q())
+      decorated_output_grob_q()[["plot"]]
     })
 
     pws <- teal.widgets::plot_with_settings_srv(
@@ -508,7 +532,7 @@ srv_tm_g_association <- function(id,
 
     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 = "Association Plot"
     )
 
@@ -527,7 +551,7 @@ srv_tm_g_association <- function(id,
           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)