From b5653100954964f4d78635d22b1d8383122f21e5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Llu=C3=ADs=20Revilla?= <185338939+llrs-roche@users.noreply.github.com> Date: Thu, 28 Nov 2024 15:20:57 +0100 Subject: [PATCH] introduce decorators for `tm_g_ci` (#1265) Part of https://github.com/insightsengineering/teal/issues/1371 WIP
Example with decorator ```r devtools::load_all("../teal") devtools::load_all(".") library(nestcolor) data <- teal_data() data <- within(data, { ADSL <- tmc_ex_adsl ADLB <- tmc_ex_adlb }) join_keys(data) <- default_cdisc_join_keys[names(data)] ADSL <- data[["ADSL"]] ADLB <- data[["ADLB"]] caption_decorator <- function(default_caption = "I am a good decorator", .var_to_replace = "plot") { teal_transform_module( label = "Caption", ui = function(id) shiny::textInput(shiny::NS(id, "footnote"), "Footnote", value = default_caption), server = make_teal_transform_server( substitute({ .var_to_replace <- .var_to_replace + ggplot2::labs(caption = footnote) }, env = list(.var_to_replace = as.name(.var_to_replace))) ) ) } app <- init( data = data, modules = modules( tm_g_ci( label = "Confidence Interval Plot", x_var = data_extract_spec( dataname = "ADSL", select = select_spec( choices = c("ARMCD", "BMRKR2"), selected = c("ARMCD"), multiple = FALSE, fixed = FALSE ) ), y_var = data_extract_spec( dataname = "ADLB", filter = list( filter_spec( vars = "PARAMCD", choices = levels(ADLB$PARAMCD), selected = levels(ADLB$PARAMCD)[1], multiple = FALSE, label = "Select lab:" ), filter_spec( vars = "AVISIT", choices = levels(ADLB$AVISIT), selected = levels(ADLB$AVISIT)[1], multiple = FALSE, label = "Select visit:" ) ), select = select_spec( label = "Analyzed Value", choices = c("AVAL", "CHG"), selected = "AVAL", multiple = FALSE, fixed = FALSE ) ), color = data_extract_spec( dataname = "ADSL", select = select_spec( label = "Color by variable", choices = c("SEX", "STRATA1", "STRATA2"), selected = c("STRATA1"), multiple = FALSE, fixed = FALSE ) ), decorators = list(caption_decorator(.var_to_replace = "plot")) ) ) ) shinyApp(app$ui, app$server) ```
--------- Co-authored-by: Marcin <133694481+m7pr@users.noreply.github.com> Co-authored-by: m7pr --- R/tm_g_ci.R | 38 +++++++++++++++++++++++++++++--------- 1 file changed, 29 insertions(+), 9 deletions(-) diff --git a/R/tm_g_ci.R b/R/tm_g_ci.R index 46d4ee865..bc21c259c 100644 --- a/R/tm_g_ci.R +++ b/R/tm_g_ci.R @@ -171,8 +171,7 @@ template_g_ci <- function(dataname, substitute( expr = { - gg <- graph_expr - print(gg) + plot <- graph_expr }, env = list(graph_expr = pipe_expr(graph_list, pipe_str = "+")) ) @@ -189,6 +188,14 @@ template_g_ci <- function(dataname, #' #' @inherit module_arguments return seealso #' +#' @section Decorating `tm_g_ci`: +#' +#' 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.clinical) #' interactive <- function() TRUE @@ -275,7 +282,8 @@ tm_g_ci <- function(label, plot_width = NULL, pre_output = NULL, post_output = NULL, - ggplot2_args = teal.widgets::ggplot2_args()) { + ggplot2_args = teal.widgets::ggplot2_args(), + decorators = NULL) { message("Initializing tm_g_ci") checkmate::assert_string(label) stat <- match.arg(stat) @@ -293,6 +301,8 @@ tm_g_ci <- function(label, checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE) checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE) checkmate::assert_class(ggplot2_args, "ggplot2_args") + decorators <- normalize_decorators(decorators) + assert_decorators(decorators, null.ok = TRUE, "plot") args <- as.list(environment()) @@ -306,7 +316,8 @@ tm_g_ci <- function(label, label = label, plot_height = plot_height, plot_width = plot_width, - ggplot2_args = ggplot2_args + ggplot2_args = ggplot2_args, + decorators = decorators ), ui = ui_g_ci, ui_args = args, @@ -355,7 +366,8 @@ ui_g_ci <- function(id, ...) { label = "Statistic to use", choices = c("mean", "median"), selected = args$stat - ) + ), + ui_decorate_teal_data(ns("decorator"), decorators = select_decorators(args$decorators, "plot")) ), forms = tagList( teal.widgets::verbatim_popup_ui(ns("rcode"), "Show R code") @@ -376,7 +388,8 @@ srv_g_ci <- function(id, label, 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") @@ -466,11 +479,18 @@ srv_g_ci <- function(id, teal.code::eval_code(anl_q(), list_calls) }) - plot_r <- reactive(all_q()[["gg"]]) + decorated_plot_q <- srv_decorate_teal_data( + id = "decorator", + data = all_q, + decorators = select_decorators(decorators, "plot"), + expr = print(plot) + ) + # Outputs to render. + plot_r <- reactive(decorated_plot_q()[["plot"]]) teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(all_q())), + verbatim_content = reactive(teal.code::get_code(req(decorated_plot_q()))), title = label ) @@ -497,7 +517,7 @@ srv_g_ci <- function(id, card$append_text("Comment", "header3") card$append_text(comment) } - card$append_src(teal.code::get_code(all_q())) + card$append_src(teal.code::get_code(req(decorated_plot_q()))) card } teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)