diff --git a/R/tm_g_association.R b/R/tm_g_association.R index 3611df804..faa79ce1c 100644 --- a/R/tm_g_association.R +++ b/R/tm_g_association.R @@ -25,6 +25,15 @@ #' #' @inherit shared_params return #' +#' @section Decorating `tm_g_association`: +#' +#' This module generates the following objects, which can be modified in place using decorators: +#' - `plot_top` (`ggplot2`) +#' - `plot_bottom` (`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 @@ -130,7 +139,8 @@ tm_g_association <- function(label = "Association", association_theme = c("gray", "bw", "linedraw", "light", "dark", "minimal", "classic", "void"), # nolint: line_length. pre_output = NULL, post_output = NULL, - ggplot2_args = teal.widgets::ggplot2_args()) { + ggplot2_args = teal.widgets::ggplot2_args(), + decorators = NULL) { message("Initializing tm_g_association") # Normalize the parameters @@ -166,6 +176,7 @@ tm_g_association <- function(label = "Association", plot_choices <- c("Bivariate1", "Bivariate2") checkmate::assert_list(ggplot2_args, types = "ggplot2_args") checkmate::assert_subset(names(ggplot2_args), c("default", plot_choices)) + checkmate::assert_list(decorators, "teal_transform_module", null.ok = TRUE) # End of assertions # Make UI args @@ -183,7 +194,7 @@ tm_g_association <- function(label = "Association", 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) ) @@ -236,6 +247,7 @@ ui_tm_g_association <- function(id, ...) { "Log transformed", value = FALSE ), + ui_transform_teal_data(ns("decorate"), transformators = args$decorators), teal.widgets::panel_group( teal.widgets::panel_item( title = "Plot settings", @@ -277,7 +289,8 @@ srv_tm_g_association <- function(id, vars, 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") @@ -463,7 +476,6 @@ srv_tm_g_association <- function(id, ) ) } - teal.code::eval_code( merged$anl_q_r(), substitute( @@ -474,10 +486,8 @@ srv_tm_g_association <- function(id, teal.code::eval_code( substitute( expr = { - plots <- plot_calls - p <- tern::stack_grobs(grobs = lapply(plots, ggplotGrob)) - grid::grid.newpage() - grid::grid.draw(p) + plot_top <- plot_calls[[1]] + plot_bottom <- plot_calls[[1]] }, env = list( plot_calls = do.call( @@ -490,9 +500,23 @@ srv_tm_g_association <- function(id, ) }) + decorated_output_q <- srv_transform_teal_data("decorate", data = output_q, transformators = decorators) + decorated_output_grob_q <- reactive({ + within( + decorated_output_q(), + { + plot <- tern::stack_grobs(grobs = lapply(list(plot_top, plot_bottom), ggplotGrob)) + grid::grid.newpage() + grid::grid.draw(plot) + } + ) + }) + + plot_r <- reactive({ req(iv_r()$is_valid()) - output_q()[["p"]] + req(output_q()) + decorated_output_grob_q()[["plot"]] }) pws <- teal.widgets::plot_with_settings_srv( @@ -508,7 +532,7 @@ srv_tm_g_association <- 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()))), title = "Association Plot" ) @@ -527,7 +551,7 @@ srv_tm_g_association <- 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()))) card } teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) diff --git a/man/tm_g_association.Rd b/man/tm_g_association.Rd index c239f6051..347744189 100644 --- a/man/tm_g_association.Rd +++ b/man/tm_g_association.Rd @@ -17,7 +17,8 @@ tm_g_association( "void"), pre_output = NULL, post_output = NULL, - ggplot2_args = teal.widgets::ggplot2_args() + ggplot2_args = teal.widgets::ggplot2_args(), + decorators = NULL ) } \arguments{ @@ -57,6 +58,9 @@ The argument is merged with options variable \code{teal.ggplot2_args} and defaul List names should match the following: \code{c("default", "Bivariate1", "Bivariate2")}. For more details see the vignette: \code{vignette("custom-ggplot2-arguments", package = "teal.widgets")}.} + +\item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} (\code{list} of \code{teal_transform_module} or \code{NULL}) optional, +if not \code{NULL}, decorator for tables or plots included in the module.} } \value{ Object of class \code{teal_module} to be used in \code{teal} applications. @@ -70,6 +74,19 @@ It supports configuring the appearance of the plots, including themes and whethe For more examples, please see the vignette "Using association plot" via \code{vignette("using-association-plot", package = "teal.modules.general")}. } +\section{Decorating \code{tm_g_association}}{ + + +This module generates the following objects, which can be modified in place using decorators: +\itemize{ +\item \code{plot_top} (\code{ggplot2}) +\item \code{plot_bottom} (\code{ggplot2}) +} + +For additional details and examples of decorators, refer to the vignette +\code{vignette("decorate-modules-output", package = "teal")} or the \code{\link[=teal_transform_module]{teal_transform_module()}} documentation. +} + \examples{ # general data example data <- teal_data()