introduce decorators for tm_g_scatterplotmatrix (#808)

Part of insightsengineering/teal#1370

<details><summary> Working Example </summary>

```r


pkgload::load_all("../teal")
pkgload::load_all(".")


footnote_dec <- teal_transform_module(
  label = "Footnote",
  ui = function(id) shiny::textInput(shiny::NS(id, "footnote"), "Footnote", value = "I am a good decorator"),
  server = function(id, data) {
    moduleServer(id, function(input, output, session) {
      logger::log_info("🟢 Footnote called to action!", namespace = "teal.modules.general")
      reactive(
        within(
          data(),
          {
            plot$xlab <- footnote
          },
          footnote = input$footnote
        )
      )
    })
  }
)

# general data example
data <- teal_data()
data <- within(data, {
  countries <- data.frame(
    id = c("DE", "FR", "IT", "ES", "PT", "GR", "NL", "BE", "LU", "AT"),
    government = factor(
      c(2, 2, 2, 1, 2, 2, 1, 1, 1, 2),
      labels = c("Monarchy", "Republic")
    ),
    language_family = factor(
      c(1, 3, 3, 3, 3, 2, 1, 1, 3, 1),
      labels = c("Germanic", "Hellenic", "Romance")
    ),
    population = c(83, 67, 60, 47, 10, 11, 17, 11, 0.6, 9),
    area = c(357, 551, 301, 505, 92, 132, 41, 30, 2.6, 83),
    gdp = c(3.4, 2.7, 2.1, 1.4, 0.3, 0.2, 0.7, 0.5, 0.1, 0.4),
    debt = c(2.1, 2.3, 2.4, 2.6, 2.3, 2.4, 2.3, 2.4, 2.3, 2.4)
  )
  sales <- data.frame(
    id = 1:50,
    country_id = sample(
      c("DE", "FR", "IT", "ES", "PT", "GR", "NL", "BE", "LU", "AT"),
      size = 50,
      replace = TRUE
    ),
    year = sort(sample(2010:2020, 50, replace = TRUE)),
    venue = sample(c("small", "medium", "large", "online"), 50, replace = TRUE),
    cancelled = sample(c(TRUE, FALSE), 50, replace = TRUE),
    quantity = rnorm(50, 100, 20),
    costs = rnorm(50, 80, 20),
    profit = rnorm(50, 20, 10)
  )
})
join_keys(data) <- join_keys(
  join_key("countries", "countries", "id"),
  join_key("sales", "sales", "id"),
  join_key("countries", "sales", c("id" = "country_id"))
)

app <- init(
  data = data,
  modules = modules(
    tm_g_scatterplotmatrix(
      label = "Scatterplot matrix",
      variables = list(
        data_extract_spec(
          dataname = "countries",
          select = select_spec(
            label = "Select variables:",
            choices = variable_choices(data[["countries"]]),
            selected = c("area", "gdp", "debt"),
            multiple = TRUE,
            ordered = TRUE,
            fixed = FALSE
          )
        ),
        data_extract_spec(
          dataname = "sales",
          filter = filter_spec(
            label = "Select variable:",
            vars = "country_id",
            choices = value_choices(data[["sales"]], "country_id"),
            selected = c("DE", "FR", "IT", "ES", "PT", "GR", "NL", "BE", "LU", "AT"),
            multiple = TRUE
          ),
          select = select_spec(
            label = "Select variables:",
            choices = variable_choices(data[["sales"]], c("quantity", "costs", "profit")),
            selected = c("quantity", "costs", "profit"),
            multiple = TRUE,
            ordered = TRUE,
            fixed = FALSE
          )
        )
      ),
      decorators = list(footnote_dec)
    )
  )
)
if (interactive()) {
  shinyApp(app$ui, app$server)
}
```

</details>

---------

Co-authored-by: github-actions <41898282+github-actions[bot]@users.noreply.github.com>
Co-authored-by: 27856297+dependabot-preview[bot]@users.noreply.github.com <27856297+dependabot-preview[bot]@users.noreply.github.com>
Co-authored-by: André Veríssimo <[email protected]>

R/tm_g_scatterplotmatrix.R

@@ -18,6 +18,14 @@
 #'
 #' @inherit shared_params return
 #'
+#' @section Decorating `tm_g_scatterplotmatrix`:
+#'
+#' This module generates the following objects, which can be modified in place using decorators:
+#' - `plot` (`trellis` - output of `lattice::splom`)
+#'
+#' 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
@@ -168,7 +176,8 @@ tm_g_scatterplotmatrix <- function(label = "Scatterplot Matrix",
                                    plot_height = c(600, 200, 2000),
                                    plot_width = NULL,
                                    pre_output = NULL,
-                                   post_output = NULL) {
+                                   post_output = NULL,
+                                   decorators = NULL) {
   message("Initializing tm_g_scatterplotmatrix")
 
   # Requires Suggested packages
@@ -193,6 +202,7 @@ tm_g_scatterplotmatrix <- function(label = "Scatterplot Matrix",
 
   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_list(decorators, "teal_transform_module", null.ok = TRUE)
   # End of assertions
 
   # Make UI args
@@ -203,7 +213,12 @@ tm_g_scatterplotmatrix <- function(label = "Scatterplot Matrix",
     server = srv_g_scatterplotmatrix,
     ui = ui_g_scatterplotmatrix,
     ui_args = args,
-    server_args = list(variables = variables, plot_height = plot_height, plot_width = plot_width),
+    server_args = list(
+      variables = variables,
+      plot_height = plot_height,
+      plot_width = plot_width,
+      decorators = decorators
+    ),
     datanames = teal.transform::get_extract_datanames(variables)
   )
   attr(ans, "teal_bookmarkable") <- TRUE
@@ -234,6 +249,7 @@ ui_g_scatterplotmatrix <- function(id, ...) {
         is_single_dataset = is_single_dataset_value
       ),
       tags$hr(),
+      ui_transform_teal_data(ns("decorator"), transformators = args$decorators),
       teal.widgets::panel_group(
         teal.widgets::panel_item(
           title = "Plot settings",
@@ -267,7 +283,14 @@ ui_g_scatterplotmatrix <- function(id, ...) {
 }
 
 # Server function for the scatterplot matrix module
-srv_g_scatterplotmatrix <- function(id, data, reporter, filter_panel_api, variables, plot_height, plot_width) {
+srv_g_scatterplotmatrix <- function(id,
+                                    data,
+                                    reporter,
+                                    filter_panel_api,
+                                    variables,
+                                    plot_height,
+                                    plot_width,
+                                    decorators) {
   with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
   with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")
   checkmate::assert_class(data, "reactive")
@@ -364,7 +387,7 @@ srv_g_scatterplotmatrix <- function(id, data, reporter, filter_panel_api, variab
           qenv,
           substitute(
             expr = {
-              g <- lattice::splom(
+              plot <- lattice::splom(
                 ANL,
                 varnames = varnames_value,
                 panel = function(x, y, ...) {
@@ -388,7 +411,6 @@ srv_g_scatterplotmatrix <- function(id, data, reporter, filter_panel_api, variab
                 alpha = alpha_value,
                 cex = cex_value
               )
-              print(g)
             },
             env = list(
               varnames_value = varnames,
@@ -407,8 +429,13 @@ srv_g_scatterplotmatrix <- function(id, data, reporter, filter_panel_api, variab
           qenv,
           substitute(
             expr = {
-              g <- lattice::splom(ANL, varnames = varnames_value, pch = 16, alpha = alpha_value, cex = cex_value)
-              g
+              plot <- lattice::splom(
+                ANL,
+                varnames = varnames_value,
+                pch = 16,
+                alpha = alpha_value,
+                cex = cex_value
+              )
             },
             env = list(varnames_value = varnames, alpha_value = alpha, cex_value = cex)
           )
@@ -417,7 +444,12 @@ srv_g_scatterplotmatrix <- function(id, data, reporter, filter_panel_api, variab
       qenv
     })
 
-    plot_r <- reactive(output_q()[["g"]])
+    decorated_output_q_no_print <- srv_transform_teal_data(id = "decorator", data = output_q, transformators = decorators)
+    decorated_output_q <- reactive(within(decorated_output_q_no_print(), print(plot)))
+    plot_r <- reactive({
+      req(output_q()) # Ensure original errors are displayed
+      decorated_output_q()[["plot"]]
+    })
 
     # Insert the plot into a plot_with_settings module
     pws <- teal.widgets::plot_with_settings_srv(
@@ -451,7 +483,7 @@ srv_g_scatterplotmatrix <- function(id, data, reporter, filter_panel_api, variab
 
     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 Scatterplotmatrix"
     )
 
@@ -470,7 +502,7 @@ srv_g_scatterplotmatrix <- function(id, data, reporter, filter_panel_api, variab
           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)