diff --git a/R/tm_g_pp_adverse_events.R b/R/tm_g_pp_adverse_events.R index 95f1356daf..38e69e67f5 100644 --- a/R/tm_g_pp_adverse_events.R +++ b/R/tm_g_pp_adverse_events.R @@ -47,7 +47,7 @@ template_adverse_events <- function(dataname = "ANL", list(), substitute( expr = { - table <- dataname %>% + table_data <- dataname %>% dplyr::select( aeterm, tox_grade, causality, outcome, action, time, decod ) %>% @@ -63,9 +63,7 @@ template_adverse_events <- function(dataname = "ANL", key_cols = NULL, default_formatting = list(all = fmt_config(align = "left")) ) - main_title(table) <- paste("Patient ID:", patient_id) - - table + main_title(table_output) <- paste("Patient ID:", patient_id) }, env = list( dataname = as.name(dataname), @@ -110,7 +108,7 @@ template_adverse_events <- function(dataname = "ANL", chart_list <- add_expr( list(), substitute( - expr = plot <- dataname %>% + expr = plot_output <- dataname %>% dplyr::select(aeterm, time, tox_grade, causality) %>% dplyr::mutate(ATOXGR = as.character(tox_grade)) %>% dplyr::arrange(dplyr::desc(ATOXGR)) %>% @@ -156,11 +154,6 @@ template_adverse_events <- function(dataname = "ANL", ) ) - chart_list <- add_expr( - expr_ls = chart_list, - new_expr = quote(plot) - ) - y$table <- bracket_expr(table_list) y$chart <- bracket_expr(chart_list) @@ -187,9 +180,35 @@ template_adverse_events <- function(dataname = "ANL", #' available choices and preselected option for the `ASTDY` variable from `dataname`. #' @param decod ([teal.transform::choices_selected()])\cr object with all #' available choices and preselected option for the `AEDECOD` variable from `dataname`. +#' @param decorators `r roxygen_decorators_param("tm_g_pp_adverse_events")` #' #' @inherit module_arguments return #' +#' @section Decorating `tm_g_pp_adverse_events`: +#' +#' This module generates the following objects, which can be modified in place using decorators:: +#' - `plot` (`ggplot2`) +#' - `table` (`listing_df` - output of `rlistings::as_listing`) +#' +#' Decorators can be applied to all outputs or only to specific objects using a +#' named list of `teal_transform_module` objects. +#' The `"default"` name is reserved for decorators that are applied to all outputs. +#' See code snippet below: +#' +#' ``` +#' tm_g_pp_adverse_events( +#' ..., # arguments for module +#' decorators = list( +#' default = list(teal_transform_module(...)), # applied to all outputs +#' plot = list(teal_transform_module(...)), # applied only to `plot` output +#' table = list(teal_transform_module(...)) # applied only to `table` output +#' ) +#' ) +#' ``` +#' +#' 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 @@ -268,7 +287,8 @@ tm_g_pp_adverse_events <- 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_pp_adverse_events") checkmate::assert_string(label) checkmate::assert_string(dataname) @@ -293,6 +313,8 @@ tm_g_pp_adverse_events <- 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, names = c("plot", "table"), null.ok = TRUE) args <- as.list(environment()) data_extract_list <- list( @@ -319,7 +341,8 @@ tm_g_pp_adverse_events <- function(label, patient_col = patient_col, plot_height = plot_height, plot_width = plot_width, - ggplot2_args = ggplot2_args + ggplot2_args = ggplot2_args, + decorators = decorators ) ), datanames = c(dataname, parentname) @@ -408,6 +431,8 @@ ui_g_adverse_events <- function(id, ...) { is_single_dataset = is_single_dataset_value ) ), + ui_decorate_teal_data(ns("d_table"), decorators = select_decorators(ui_args$decorators, "table")), + ui_decorate_teal_data(ns("d_plot"), decorators = select_decorators(ui_args$decorators, "plot")), teal.widgets::panel_item( title = "Plot settings", collapsed = TRUE, @@ -445,7 +470,8 @@ srv_g_adverse_events <- function(id, plot_height, plot_width, label, - 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") @@ -564,14 +590,29 @@ srv_g_adverse_events <- function(id, paste("
Patient ID:", all_q()[["pt_id"]], "
") }) - output$table <- DT::renderDataTable( - expr = teal.code::dev_suppress(all_q()[["table"]]), - options = list(pageLength = input$table_rows) + # Allow for the table and plot qenv to be joined + table_q <- reactive(within(all_q(), table <- table_output)) + plot_q <- reactive(within(all_q(), plot <- plot_output)) + + decorated_all_q_table <- srv_decorate_teal_data( + "d_table", + data = table_q, + decorators = select_decorators(decorators, "table"), + expr = table + ) + + decorated_all_q_plot <- srv_decorate_teal_data( + "d_plot", + data = plot_q, + decorators = select_decorators(decorators, "plot"), + expr = print(plot) ) + table_r <- reactive(teal.code::dev_suppress(decorated_all_q_table()[["table"]])) + plot_r <- reactive({ req(iv_r()$is_valid()) - all_q()[["plot"]] + decorated_all_q_plot()[["plot"]] }) pws <- teal.widgets::plot_with_settings_srv( @@ -581,9 +622,18 @@ srv_g_adverse_events <- function(id, width = plot_width ) + output$table <- DT::renderDataTable( + expr = table_r(), + options = list(pageLength = input$table_rows) + ) + + decorated_all_q <- reactive( + c(decorated_all_q_table(), decorated_all_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_all_q()))), title = label ) @@ -597,14 +647,14 @@ srv_g_adverse_events <- function(id, filter_panel_api = filter_panel_api ) card$append_text("Table", "header3") - card$append_table(teal.code::dev_suppress(all_q()[["table"]])) + card$append_table(teal.code::dev_suppress(table_r())) card$append_text("Plot", "header3") card$append_plot(plot_r(), dim = pws$dim()) if (!comment == "") { 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_all_q()))) card } teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) diff --git a/man/tm_g_pp_adverse_events.Rd b/man/tm_g_pp_adverse_events.Rd index a5e56dd54b..8182768b0f 100644 --- a/man/tm_g_pp_adverse_events.Rd +++ b/man/tm_g_pp_adverse_events.Rd @@ -21,7 +21,8 @@ tm_g_pp_adverse_events( plot_width = NULL, pre_output = NULL, post_output = NULL, - ggplot2_args = teal.widgets::ggplot2_args() + ggplot2_args = teal.widgets::ggplot2_args(), + decorators = NULL ) } \arguments{ @@ -72,6 +73,12 @@ For example the \code{\link[shiny:helpText]{shiny::helpText()}} elements are use for the module plot. The argument is merged with option \code{teal.ggplot2_args} and with default module arguments (hard coded in the module body). 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}, named \code{list} of \code{teal_transform_module} or \code{NULL}) optional, if not \code{NULL}, decorator for tables or plots included in the module. When a named list of \code{teal_transform_module}, the decorators are applied to the respective output objects. + +Otherwise, the decorators are applied to all objects, which is equivalent as using the name \code{default}. + +See section "Decorating \code{tm_g_pp_adverse_events}" below for more details.} } \value{ a \code{teal_module} object. @@ -79,6 +86,34 @@ a \code{teal_module} object. \description{ This module produces an adverse events table and \code{\link[ggplot2:ggplot]{ggplot2::ggplot()}} type plot using ADaM datasets. } +\section{Decorating \code{tm_g_pp_adverse_events}}{ + + +This module generates the following objects, which can be modified in place using decorators:: +\itemize{ +\item \code{plot} (\code{ggplot2}) +\item \code{table} (\code{listing_df} - output of \code{rlistings::as_listing}) +} + +Decorators can be applied to all outputs or only to specific objects using a +named list of \code{teal_transform_module} objects. +The \code{"default"} name is reserved for decorators that are applied to all outputs. +See code snippet below: + +\if{html}{\out{
}}\preformatted{tm_g_pp_adverse_events( + ..., # arguments for module + decorators = list( + default = list(teal_transform_module(...)), # applied to all outputs + plot = list(teal_transform_module(...)), # applied only to `plot` output + table = list(teal_transform_module(...)) # applied only to `table` output + ) +) +}\if{html}{\out{
}} + +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{ library(nestcolor) library(dplyr)