Add transformators and decorators to modules

DESCRIPTION

@@ -50,6 +50,7 @@ Suggests:
     withr (>= 3.0.0)
 Remotes:
     insightsengineering/osprey
+    insightsengineering/teal
 Config/Needs/verdepcheck: insightsengineering/osprey, rstudio/shiny,
     insightsengineering/teal, insightsengineering/teal.slice,
     insightsengineering/teal.transform, mllg/checkmate, tidyverse/dplyr,

NEWS.md

@@ -1,5 +1,8 @@
 # teal.osprey 0.4.0.9002
 
+### Enhancements
+- All `tm_g_*` modules accept `transformators` (input data transforms in the filter sidebar) and `decorators` (plot output transforms in the encoding panel).
+
 # teal.osprey 0.4.0
 
 

R/argument_convention.R

@@ -36,6 +36,15 @@
 #' @param plot_width (`numeric(3)`)\cr
 #'  vector to indicate default value, minimum and maximum values.
 #'
+#' @param transformators (`list` of `teal_transform_module`) optional,
+#' input data transforms applied after filtering (UI in the filter sidebar under
+#' **Transform Data**). See `vignette("transform-input-data", package = "teal")`.
+#'
+#' @param decorators `r lifecycle::badge("experimental")`
+#' (named `list` of `teal_transform_module`) optional,
+#' decorators for the module `plot` output. See [decorate_module_section] for which
+#' object types are supported per module.
+#'
 #' @return the [teal::module()] object.
 #'
 #' @name argument_convention

R/decorate_module_section.R

@@ -0,0 +1,64 @@
+#' Decorating and transforming `teal.osprey` modules
+#'
+#' @description
+#' Documentation for the `transformators` and `decorators` arguments accepted by all
+#' `tm_g_*` modules in this package.
+#'
+#' @section Decorating Module:
+#'
+#' All `teal.osprey` plot modules expose a single decoratable output object named `plot`.
+#' Decorators are passed as a named `list` of [`teal::teal_transform_module()`] objects;
+#' the name of each list element must match the output object name (`"plot"`).
+#'
+#' ```r
+#' tm_g_waterfall(
+#'   ...,
+#'   decorators = list(
+#'     plot = teal::teal_transform_module(...) # applied only to `plot`
+#'   )
+#' )
+#' ```
+#'
+#' Decorator UI controls appear in the module **encoding** panel. Decorators run in the
+#' module server after the plot is created and before it is rendered.
+#'
+#' **Important:** decorators must not change the class of `plot`. Use transformations
+#' appropriate to the object type returned by the underlying [osprey] function.
+#'
+#' | Module | Output | Typical class of `plot` |
+#' |--------|--------|-------------------------|
+#' | `tm_g_spiderplot` | `plot` | `ggplot` |
+#' | `tm_g_butterfly` | `plot` | `grob` / `gtable` |
+#' | `tm_g_waterfall` | `plot` | `grob` / `gtable` |
+#' | `tm_g_swimlane` | `plot` | `grob` / `gtable` |
+#' | `tm_g_patient_profile` | `plot` | `grob` (`cowplot` layout) |
+#' | `tm_g_ae_oview` | `plot` | `grob` |
+#' | `tm_g_ae_sub` | `plot` | `grob` |
+#' | `tm_g_events_term_id` | `plot` | `grob` |
+#' | `tm_g_heat_bygrade` | `plot` | `grob` / `gtable` |
+#'
+#' - For **`ggplot`** outputs (`tm_g_spiderplot` only), use `ggplot2` modifiers
+#'   (for example via [`teal::make_teal_transform_server()`]).
+#' - For **`grob`** outputs (all other modules), use [`tern::decorate_grob()`] or
+#'   other grid-compatible adjustments. Applying `ggplot2` layers to `plot` in
+#'   those modules will fail silently or break rendering.
+#'
+#' Four modules (`tm_g_ae_oview`, `tm_g_ae_sub`, `tm_g_events_term_id`, `tm_g_heat_bygrade`)
+#' also provide built-in title and footnote controls via [`ui_g_decorate()`] and
+#' [`srv_g_decorate()`]. User-defined decorators run **before** that built-in decoration step.
+#'
+#' @section Transforming input data:
+#'
+#' All `tm_g_*` modules also accept `transformators`, a named `list` of
+#' [`teal::teal_transform_module()`] objects that modify module **input** data after
+#' filtering. Their UI appears in the app filter sidebar under **Transform Data**.
+#'
+#' See `vignette("transform-input-data", package = "teal")` for transformators and
+#' `vignette("transform-module-output", package = "teal")` for decorators.
+#'
+#' A demo app using every module with both mechanisms is in
+#' `system.file("examples", "app_decorators_transformators.R", package = "teal.osprey")`.
+#'
+#' @name decorate_module_section
+#' @keywords internal
+NULL

R/tm_g_ae_oview.R

@@ -12,6 +12,8 @@
 #'   sub-groups (e.g. Serious events, Related events, etc.)
 #'
 #' @inherit argument_convention return
+#' @inheritSection decorate_module_section Decorating Module
+#' @inheritSection decorate_module_section Transforming input data
 #' @inheritSection teal::example_module Reporting
 #'
 #' @export
@@ -80,7 +82,8 @@
                           fontsize = c(5, 3, 7),
                           plot_height = c(600L, 200L, 2000L),
                           plot_width = NULL,
-                          transformators = list()) {
+                          transformators = list(),
+                          decorators = list()) {
   message("Initializing tm_g_ae_oview")
   checkmate::assert_class(arm_var, classes = "choices_selected")
   checkmate::assert_class(flag_var_anl, classes = "choices_selected")
@@ -103,6 +106,8 @@
     plot_width[1],
     lower = plot_width[2], upper = plot_width[3], null.ok = TRUE, .var.name = "plot_width"
   )
+  assert_transformators(transformators)
+  teal::assert_decorators(decorators, "plot")
 
   args <- as.list(environment())
 
@@ -113,7 +118,8 @@
       label = label,
       dataname = dataname,
       plot_height = plot_height,
-      plot_width = plot_width
+      plot_width = plot_width,
+      decorators = decorators
     ),
     ui = ui_g_ae_oview,
     ui_args = args,
@@ -180,6 +186,10 @@
         selected = "left",
         multiple = FALSE
       ),
+      teal::ui_transform_teal_data(
+        ns("decorator"),
+        transformators = select_decorators(args$decorators, "plot")
+      ),
       ui_g_decorate(
         ns(NULL),
         fontsize = args$fontsize,
@@ -195,7 +205,8 @@
                            dataname,
                            label,
                            plot_height,
-                           plot_width) {
+                           plot_width,
+                           decorators) {
   checkmate::assert_class(data, "reactive")
   checkmate::assert_class(isolate(data()), "teal_data")
 
@@ -226,12 +237,7 @@
       iv
     })
 
-    decorate_output <- srv_g_decorate(
-      id = NULL, plt = plot_r,
-      plot_height = plot_height, plot_width = plot_width
-    )
-    font_size <- decorate_output$font_size
-    pws <- decorate_output$pws
+    font_size <- reactive(input$fontsize)
 
     observeEvent(list(input$diff_ci_method, input$conf_level), {
       req(!is.null(input$diff_ci_method) && !is.null(input$conf_level))
@@ -295,13 +301,13 @@
           "Treatment or Control not found in Arm Variable. Perhaps they have been filtered out?"
         ))
 
         q1 <- obj %>%
           teal.code::eval_code(
             code = as.expression(c(
               bquote(anl_labels <- formatters::var_labels(.(as.name(dataname)), fill = FALSE)),
               bquote(
                 flags <- .(as.name(dataname)) %>%
                   select(all_of(.(input$flag_var_anl))) %>%
                   rename_at(vars(.(input$flag_var_anl)), function(x) paste0(x, ": ", anl_labels[x]))
               )
             ))
@@ -332,7 +338,21 @@
       })
     )
 
-    plot_r <- reactive(output_q()[["plot"]])
-    set_chunk_dims(pws, output_q)
+    decorated_output_q <- teal::srv_transform_teal_data(
+      id = "decorator",
+      data = output_q,
+      transformators = select_decorators(decorators, "plot"),
+      expr = quote(plot)
+    )
+    plot_r <- reactive(decorated_output_q()[["plot"]])
+
+    decorate_output <- srv_g_decorate(
+      id = NULL,
+      plt = plot_r,
+      plot_height = plot_height,
+      plot_width = plot_width
+    )
+    pws <- decorate_output$pws
+    set_chunk_dims(pws, decorated_output_q)
   })
 }

R/tm_g_ae_sub.R

@@ -13,6 +13,8 @@
 #' @author Molly He (hey59) \email{hey59@gene.com}
 #'
 #' @inherit argument_convention return
+#' @inheritSection decorate_module_section Decorating Module
+#' @inheritSection decorate_module_section Transforming input data
 #' @inheritSection teal::example_module Reporting
 #'
 #' @export
@@ -56,7 +58,8 @@
                         plot_height = c(600L, 200L, 2000L),
                         plot_width = NULL,
                         fontsize = c(5, 3, 7),
-                        transformators = list()) {
+                        transformators = list(),
+                        decorators = list()) {
   message("Initializing tm_g_ae_sub")
   checkmate::assert_class(arm_var, classes = "choices_selected")
   checkmate::assert_class(group_var, classes = "choices_selected")
@@ -76,6 +79,8 @@
     plot_width[1],
     lower = plot_width[2], upper = plot_width[3], null.ok = TRUE, .var.name = "plot_width"
   )
+  assert_transformators(transformators)
+  teal::assert_decorators(decorators, "plot")
 
   module(
     label = label,
@@ -84,13 +89,15 @@
       label = label,
       dataname = dataname,
       plot_height = plot_height,
-      plot_width = plot_width
+      plot_width = plot_width,
+      decorators = decorators
     ),
     ui = ui_g_ae_sub,
     ui_args = list(
       arm_var = arm_var,
       group_var = group_var,
-      fontsize = fontsize
+      fontsize = fontsize,
+      decorators = decorators
     ),
     transformators = transformators,
     datanames = c("ADSL", dataname)
@@ -156,6 +163,10 @@
           max = 1,
           value = 0.95
         ),
+        teal::ui_transform_teal_data(
+          ns("decorator"),
+          transformators = select_decorators(args$decorators, "plot")
+        ),
         ui_g_decorate(
           ns(NULL),
           fontsize = args$fontsize,
@@ -172,7 +183,8 @@
                          dataname,
                          label,
                          plot_height,
-                         plot_width) {
+                         plot_width,
+                         decorators) {
   checkmate::assert_class(data, "reactive")
   checkmate::assert_class(shiny::isolate(data()), "teal_data")
 
@@ -206,14 +218,7 @@
       iv
     })
 
-    decorate_output <- srv_g_decorate(
-      id = NULL,
-      plt = plot_r,
-      plot_height = plot_height,
-      plot_width = plot_width
-    )
-    font_size <- decorate_output$font_size
-    pws <- decorate_output$pws
+    font_size <- reactive(input$fontsize)
 
     observeEvent(input$arm_var, ignoreNULL = TRUE, {
       arm_var <- input$arm_var
@@ -344,7 +349,7 @@
           bquote(group_labels <- setNames(.(group_labels), .(input$groups)))
         }
 
         q1 <- teal.code::eval_code(obj, code = group_labels_call) %>%
           teal.code::eval_code(code = "")
 
         teal.reporter::teal_card(q1) <- c(teal.reporter::teal_card(q1), "### Plot")
@@ -374,7 +379,21 @@
       })
     )
 
-    plot_r <- reactive(output_q()[["plot"]])
-    set_chunk_dims(pws, output_q)
+    decorated_output_q <- teal::srv_transform_teal_data(
+      id = "decorator",
+      data = output_q,
+      transformators = select_decorators(decorators, "plot"),
+      expr = quote(plot)
+    )
+    plot_r <- reactive(decorated_output_q()[["plot"]])
+
+    decorate_output <- srv_g_decorate(
+      id = NULL,
+      plt = plot_r,
+      plot_height = plot_height,
+      plot_width = plot_width
+    )
+    pws <- decorate_output$pws
+    set_chunk_dims(pws, decorated_output_q)
   })
 }

R/tm_g_butterfly.R

@@ -33,6 +33,8 @@
 #'   used directly as filter.
 #'
 #' @inherit argument_convention return
+#' @inheritSection decorate_module_section Decorating Module
+#' @inheritSection decorate_module_section Transforming input data
 #' @inheritSection teal::example_module Reporting
 #'
 #' @export
@@ -121,7 +123,8 @@
                            plot_width = NULL,
                            pre_output = NULL,
                            post_output = NULL,
-                           transformators = list()) {
+                           transformators = list(),
+                           decorators = list()) {
   message("Initializing tm_g_butterfly")
   checkmate::assert_string(label)
   checkmate::assert_string(dataname)
@@ -144,14 +147,22 @@
     null.ok = TRUE,
     .var.name = "plot_width"
   )
+  assert_transformators(transformators)
+  teal::assert_decorators(decorators, "plot")
 
   args <- as.list(environment())
 
   module(
     label = label,
     datanames = c("ADSL", dataname),
     server = srv_g_butterfly,
-    server_args = list(dataname = dataname, label = label, plot_height = plot_height, plot_width = plot_width),
+    server_args = list(
+      dataname = dataname,
+      label = label,
+      plot_height = plot_height,
+      plot_width = plot_width,
+      decorators = decorators
+    ),
     ui = ui_g_butterfly,
     ui_args = args,
     transformators = transformators
@@ -251,14 +262,18 @@
         ns("legend_on"),
         "Add legend",
         value = a$legend_on
+      ),
+      teal::ui_transform_teal_data(
+        ns("decorator"),
+        transformators = select_decorators(a$decorators, "plot")
       )
     ),
     pre_output = a$pre_output,
     post_output = a$post_output
   )
 }
 
-srv_g_butterfly <- function(id, data, dataname, label, plot_height, plot_width) {
+srv_g_butterfly <- function(id, data, dataname, label, plot_height, plot_width, decorators) {
   checkmate::assert_class(data, "reactive")
   checkmate::assert_class(shiny::isolate(data()), "teal_data")
 
@@ -425,8 +440,8 @@
         q1 <- teal.code::eval_code(
           obj,
           code = bquote({
             ADSL <- ADSL[, .(adsl_vars)] %>% as.data.frame()
             ANL <- .(as.name(dataname))[, .(anl_vars)] %>% as.data.frame()
           })
         )
 
@@ -434,8 +449,8 @@
           q1 <- teal.code::eval_code(
             q1,
             code = bquote(
               ANL <- quick_filter(.(filter_var), ANL) %>%
                 droplevels() %>%
                 as.data.frame()
             )
           )
@@ -444,7 +459,7 @@
         q1 <- teal.code::eval_code(
           q1,
           code = bquote({
             ANL_f <- left_join(ADSL, ANL, by = c("USUBJID", "STUDYID")) %>% as.data.frame()
             ANL_f <- na.omit(ANL_f)
           })
         )
@@ -520,7 +535,13 @@
       })
     )
 
-    plot_r <- reactive(output_q()[["plot"]])
+    decorated_output_q <- teal::srv_transform_teal_data(
+      id = "decorator",
+      data = output_q,
+      transformators = select_decorators(decorators, "plot"),
+      expr = quote(plot)
+    )
+    plot_r <- reactive(decorated_output_q()[["plot"]])
 
     # Insert the plot into a plot_with_settings module from teal.widgets
     pws <- teal.widgets::plot_with_settings_srv(
@@ -530,6 +551,6 @@
       width = plot_width
     )
 
-    set_chunk_dims(pws, output_q)
+    set_chunk_dims(pws, decorated_output_q)
   })
 }