Skip to content

Commit 612bb06

Browse files
authored
introduce decorators for tm_g_response (#802)
Part of https://github.com/insightsengineering/teal/issues/1370 <details><summary> Working Example </summary> ```r pkgload::load_all("../teal") pkgload::load_all("../teal.modules.general") 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(), { footnote_str <- footnote plot <- plot + ggplot2::labs(caption = footnote_str) }, footnote = input$footnote ) ) }) } ) title_plot <- teal_transform_module( server = make_teal_transform_server( expression( logger::log_info("🔴 Title being called to action!", namespace = "teal.modules.general"), plot <- plot + ggplot2::ggtitle("A title to the plot") ) ) ) # CDISC data example data <- teal_data() data <- within(data, { require(nestcolor) ADSL <- rADSL }) join_keys(data) <- default_cdisc_join_keys[names(data)] app <- init( data = data, modules = modules( tm_g_response( label = "Response Plots", decorators = list(footnote_dec, title_plot), response = data_extract_spec( dataname = "ADSL", select = select_spec( label = "Select variable:", choices = variable_choices(data[["ADSL"]], c("BMRKR2", "COUNTRY")), selected = "BMRKR2", multiple = FALSE, fixed = FALSE ) ), x = data_extract_spec( dataname = "ADSL", select = select_spec( label = "Select variable:", choices = variable_choices(data[["ADSL"]], c("SEX", "RACE")), selected = "RACE", multiple = FALSE, fixed = FALSE ) ) ) ) ) if (interactive()) { shinyApp(app$ui, app$server) } ``` </details> --------- Signed-off-by: André Veríssimo <[email protected]>
1 parent cf4371f commit 612bb06

16 files changed

+104
-65
lines changed

R/tm_g_response.R

Lines changed: 31 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -39,6 +39,14 @@
3939
#' @note For more examples, please see the vignette "Using response plot" via
4040
#' `vignette("using-response-plot", package = "teal.modules.general")`.
4141
#'
42+
#' @section Decorating `tm_g_response`:
43+
#'
44+
#' This module generates the following objects, which can be modified in place using decorators:
45+
#' - `plot` (`ggplot2`)
46+
#'
47+
#' For additional details and examples of decorators, refer to the vignette
48+
#' `vignette("decorate-modules-output", package = "teal")` or the [`teal_transform_module()`] documentation.
49+
#'
4250
#' @examplesShinylive
4351
#' library(teal.modules.general)
4452
#' interactive <- function() TRUE
@@ -147,7 +155,8 @@ tm_g_response <- function(label = "Response Plot",
147155
ggtheme = c("gray", "bw", "linedraw", "light", "dark", "minimal", "classic", "void"),
148156
ggplot2_args = teal.widgets::ggplot2_args(),
149157
pre_output = NULL,
150-
post_output = NULL) {
158+
post_output = NULL,
159+
decorators = NULL) {
151160
message("Initializing tm_g_response")
152161

153162
# Normalize the parameters
@@ -191,6 +200,8 @@ tm_g_response <- function(label = "Response Plot",
191200

192201
checkmate::assert_multi_class(pre_output, c("shiny.tag", "shiny.tag.list", "html"), null.ok = TRUE)
193202
checkmate::assert_multi_class(post_output, c("shiny.tag", "shiny.tag.list", "html"), null.ok = TRUE)
203+
204+
checkmate::assert_list(decorators, "teal_transform_module", null.ok = TRUE)
194205
# End of assertions
195206

196207
# Make UI args
@@ -210,7 +221,12 @@ tm_g_response <- function(label = "Response Plot",
210221
ui_args = args,
211222
server_args = c(
212223
data_extract_list,
213-
list(plot_height = plot_height, plot_width = plot_width, ggplot2_args = ggplot2_args)
224+
list(
225+
plot_height = plot_height,
226+
plot_width = plot_width,
227+
ggplot2_args = ggplot2_args,
228+
decorators = decorators
229+
)
214230
),
215231
datanames = teal.transform::get_extract_datanames(data_extract_list)
216232
)
@@ -269,6 +285,7 @@ ui_g_response <- function(id, ...) {
269285
selected = ifelse(args$freq, "frequency", "density"),
270286
justified = TRUE
271287
),
288+
ui_teal_transform_data(ns("decorator"), transformators = args$decorators),
272289
teal.widgets::panel_group(
273290
teal.widgets::panel_item(
274291
title = "Plot settings",
@@ -304,7 +321,8 @@ srv_g_response <- function(id,
304321
col_facet,
305322
plot_height,
306323
plot_width,
307-
ggplot2_args) {
324+
ggplot2_args,
325+
decorators) {
308326
with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
309327
with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")
310328
checkmate::assert_class(data, "reactive")
@@ -523,8 +541,7 @@ srv_g_response <- function(id,
523541
)
524542

525543
plot_call <- substitute(expr = {
526-
p <- plot_call + labs + ggthemes + themes
527-
print(p)
544+
plot <- plot_call + labs + ggthemes + themes
528545
}, env = list(
529546
plot_call = plot_call,
530547
labs = parsed_ggplot2_args$labs,
@@ -535,7 +552,13 @@ srv_g_response <- function(id,
535552
teal.code::eval_code(qenv, plot_call)
536553
})
537554

538-
plot_r <- reactive(output_q()[["p"]])
555+
decorated_output_q <- srv_teal_transform_data(id = "decorator", data = output_q, transformators = decorators)
556+
557+
decorated_output_plot_q <- reactive(within(decorated_output_q(), print(plot)))
558+
plot_r <- reactive({
559+
req(output_q()) # Ensure original errors are displayed
560+
decorated_output_plot_q()[["plot"]]
561+
})
539562

540563
# Insert the plot into a plot_with_settings module from teal.widgets
541564
pws <- teal.widgets::plot_with_settings_srv(
@@ -547,7 +570,7 @@ srv_g_response <- function(id,
547570

548571
teal.widgets::verbatim_popup_srv(
549572
id = "rcode",
550-
verbatim_content = reactive(teal.code::get_code(output_q())),
573+
verbatim_content = reactive(teal.code::get_code(req(decorated_output_plot_q()))),
551574
title = "Show R Code for Response"
552575
)
553576

@@ -566,7 +589,7 @@ srv_g_response <- function(id,
566589
card$append_text("Comment", "header3")
567590
card$append_text(comment)
568591
}
569-
card$append_src(teal.code::get_code(output_q()))
592+
card$append_src(teal.code::get_code(req(decorated_output_plot_q())))
570593
card
571594
}
572595
teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)

man/tm_a_pca.Rd

Lines changed: 4 additions & 4 deletions
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

man/tm_a_regression.Rd

Lines changed: 4 additions & 4 deletions
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

0 commit comments

Comments
 (0)