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

Author: averissimo

R/tm_g_bivariate.R

@@ -46,6 +46,15 @@
 #'
 #' @inherit shared_params return
 #'
+#' @section Decorating `tm_outliers`:
+#'
+#' 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.general)
 #' interactive <- function() TRUE
@@ -185,7 +194,8 @@ tm_g_bivariate <- function(label = "Bivariate Plots",
                            ggtheme = c("gray", "bw", "linedraw", "light", "dark", "minimal", "classic", "void"),
                            ggplot2_args = teal.widgets::ggplot2_args(),
                            pre_output = NULL,
-                           post_output = NULL) {
+                           post_output = NULL,
+                           decorators = NULL) {
   message("Initializing tm_g_bivariate")
 
   # Normalize the parameters
@@ -265,6 +275,8 @@ tm_g_bivariate <- function(label = "Bivariate Plots",
 
   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
@@ -288,7 +300,7 @@ tm_g_bivariate <- function(label = "Bivariate Plots",
     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)
   )
@@ -338,6 +350,7 @@ ui_g_bivariate <- function(id, ...) {
           justified = TRUE
         )
       ),
+      ui_teal_transform_data(ns("decorate"), transformators = args$decorators),
       if (!is.null(args$row_facet) || !is.null(args$col_facet)) {
         tags$div(
           class = "data-extract-box",
@@ -451,7 +464,8 @@ srv_g_bivariate <- function(id,
                             size,
                             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")
@@ -648,37 +662,50 @@ srv_g_bivariate <- function(id,
         }
       }
 
+      teal.code::eval_code(merged$anl_q_r(), substitute(expr = plot <- cl, env = list(cl = cl)))
+    })
+
+    decorated_output_q <- srv_teal_transform_data("decorate", data = output_q, transformators = decorators)
+
+    decorated_output_q_facets <- reactive({
+
+      ANL <- merged$anl_q_r()[["ANL"]]
+      row_facet_name <- as.vector(merged$anl_input_r()$columns_source$row_facet)
+      col_facet_name <- as.vector(merged$anl_input_r()$columns_source$col_facet)
+
       # Add labels to facets
       nulled_row_facet_name <- varname_w_label(row_facet_name, ANL)
       nulled_col_facet_name <- varname_w_label(col_facet_name, ANL)
+      facetting <- (isTRUE(input$facetting) && (!is.null(row_facet_name) || !is.null(col_facet_name)))
       without_facet <- (is.null(nulled_row_facet_name) && is.null(nulled_col_facet_name)) || !facetting
 
       print_call <- if (without_facet) {
-        quote(print(p))
+        quote(print(plot))
       } else {
         substitute(
           expr = {
             # Add facetting labels
             # optional: grid.newpage() # nolint: commented_code.
             # Prefixed with teal.modules.general as its usage will appear in "Show R code"
-            p <- teal.modules.general::add_facet_labels(
-              p,
+            plot <- teal.modules.general::add_facet_labels(
+              plot,
               xfacet_label = nulled_col_facet_name,
               yfacet_label = nulled_row_facet_name
             )
             grid::grid.newpage()
-            grid::grid.draw(p)
+            grid::grid.draw(plot)
           },
           env = list(nulled_col_facet_name = nulled_col_facet_name, nulled_row_facet_name = nulled_row_facet_name)
         )
       }
-
-      teal.code::eval_code(merged$anl_q_r(), substitute(expr = p <- cl, env = list(cl = cl))) %>%
+      decorated_output_q() %>%
         teal.code::eval_code(print_call)
     })
 
+
     plot_r <- reactive({
-      output_q()[["p"]]
+      req(output_q())
+      decorated_output_q_facets()[["plot"]]
     })
 
     pws <- teal.widgets::plot_with_settings_srv(
@@ -690,7 +717,7 @@ srv_g_bivariate <- 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_facets()))),
       title = "Bivariate Plot"
     )
 
@@ -709,7 +736,7 @@ srv_g_bivariate <- 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_facets)))
         card
       }
       teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)

R/tm_g_response.R

@@ -39,6 +39,14 @@
 #' @note For more examples, please see the vignette "Using response plot" via
 #' `vignette("using-response-plot", package = "teal.modules.general")`.
 #'
+#' @section Decorating `tm_g_response`:
+#'
+#' 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.general)
 #' interactive <- function() TRUE
@@ -147,7 +155,8 @@ tm_g_response <- function(label = "Response Plot",
                           ggtheme = c("gray", "bw", "linedraw", "light", "dark", "minimal", "classic", "void"),
                           ggplot2_args = teal.widgets::ggplot2_args(),
                           pre_output = NULL,
-                          post_output = NULL) {
+                          post_output = NULL,
+                          decorators = NULL) {
   message("Initializing tm_g_response")
 
   # Normalize the parameters
@@ -191,6 +200,8 @@ tm_g_response <- function(label = "Response Plot",
 
   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
@@ -210,7 +221,12 @@ tm_g_response <- function(label = "Response Plot",
     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)
   )
@@ -269,6 +285,7 @@ ui_g_response <- function(id, ...) {
         selected = ifelse(args$freq, "frequency", "density"),
         justified = TRUE
       ),
+      ui_teal_transform_data(ns("decorator"), transformators = args$decorators),
       teal.widgets::panel_group(
         teal.widgets::panel_item(
           title = "Plot settings",
@@ -304,7 +321,8 @@ srv_g_response <- function(id,
                            col_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")
@@ -523,8 +541,7 @@ srv_g_response <- function(id,
       )
 
       plot_call <- substitute(expr = {
-        p <- plot_call + labs + ggthemes + themes
-        print(p)
+        plot <- plot_call + labs + ggthemes + themes
       }, env = list(
         plot_call = plot_call,
         labs = parsed_ggplot2_args$labs,
@@ -535,7 +552,13 @@ srv_g_response <- function(id,
       teal.code::eval_code(qenv, plot_call)
     })
 
-    plot_r <- reactive(output_q()[["p"]])
+    decorated_output_q <- srv_teal_transform_data(id = "decorator", data = output_q, transformators = decorators)
+
+    decorated_output_plot_q <- reactive(within(decorated_output_q(), print(plot)))
+    plot_r <- reactive({
+      req(output_q()) # Ensure original errors are displayed
+      decorated_output_plot_q()[["plot"]]
+    })
 
     # Insert the plot into a plot_with_settings module from teal.widgets
     pws <- teal.widgets::plot_with_settings_srv(
@@ -547,7 +570,7 @@ srv_g_response <- 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_plot_q()))),
       title = "Show R Code for Response"
     )
 
@@ -566,7 +589,7 @@ srv_g_response <- 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_plot_q())))
         card
       }
       teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)