From 5b87fdc8e342bd57fb217f92321d8dfca3d1818f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Llu=C3=ADs=20Revilla?= <185338939+llrs-roche@users.noreply.github.com> Date: Wed, 4 Dec 2024 12:44:42 +0100 Subject: [PATCH] Introduce decorator for `tm_t_events` (#1275) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Part of https://github.com/insightsengineering/teal/issues/1371
Example with decorator ```r load_all("../teal") load_all(".") data <- teal_data() data <- within(data, { ADSL <- tmc_ex_adsl ADAE <- tmc_ex_adae }) join_keys(data) <- default_cdisc_join_keys[names(data)] ADSL <- data[["ADSL"]] ADAE <- data[["ADAE"]] insert_rrow_decorator <- function(default_caption = "I am a good new row", .var_to_replace = "table") { teal_transform_module( label = "New row", ui = function(id) shiny::textInput(shiny::NS(id, "new_row"), "New row", value = default_caption), server = make_teal_transform_server( substitute({ .var_to_replace <- rtables::insert_rrow(.var_to_replace, rtables::rrow(new_row)) }, env = list(.var_to_replace = as.name(.var_to_replace))) ) ) } app <- init( data = data, modules = modules( tm_t_events( label = "Adverse Event Table", dataname = "ADAE", arm_var = choices_selected(c("ARM", "ARMCD"), "ARM"), llt = choices_selected( choices = variable_choices(ADAE, c("AETERM", "AEDECOD")), selected = c("AEDECOD") ), hlt = choices_selected( choices = variable_choices(ADAE, c("AEBODSYS", "AESOC")), selected = "AEBODSYS" ), add_total = TRUE, event_type = "adverse event", decorators = list(insert_rrow_decorator()) ) ) ) if (interactive()) { shinyApp(app$ui, app$server) } ```
--------- Co-authored-by: André Veríssimo <211358+averissimo@users.noreply.github.com> --- R/tm_t_events.R | 46 +++++++++++++++++++++++++++++++++------------- man/tm_t_events.Rd | 21 ++++++++++++++++++++- 2 files changed, 53 insertions(+), 14 deletions(-) diff --git a/R/tm_t_events.R b/R/tm_t_events.R index c5b353a80..31efb865d 100644 --- a/R/tm_t_events.R +++ b/R/tm_t_events.R @@ -266,7 +266,7 @@ template_events <- function(dataname, # Full table. y$table <- substitute( - expr = result <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = parent), + expr = table <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = parent), env = list(parent = as.name(parentname)) ) @@ -275,7 +275,7 @@ template_events <- function(dataname, prune_list <- add_expr( prune_list, quote( - pruned_result <- result %>% rtables::prune_table() + pruned_result <- rtables::prune_table(table) ) ) @@ -284,7 +284,7 @@ template_events <- function(dataname, prune_list <- add_expr( prune_list, substitute( - expr = col_indices <- 1:(ncol(result) - add_total), + expr = col_indices <- 1:(ncol(table) - add_total), env = list(add_total = add_total) ) ) @@ -366,7 +366,7 @@ template_events <- function(dataname, sort_list <- add_expr( sort_list, substitute( - expr = idx_split_col <- which(sapply(col_paths(result), tail, 1) == sort_freq_col), + expr = idx_split_col <- which(sapply(col_paths(table), tail, 1) == sort_freq_col), env = list(sort_freq_col = sort_freq_col) ) ) @@ -378,7 +378,7 @@ template_events <- function(dataname, quote(cont_n_allcols) } scorefun_llt <- if (add_total) { - quote(score_occurrences_cols(col_indices = seq(1, ncol(result)))) + quote(score_occurrences_cols(col_indices = seq(1, ncol(table)))) } else { quote(score_occurrences) } @@ -458,9 +458,18 @@ template_events <- function(dataname, #' It defines the grouping variable(s) in the results table. #' If there are two elements selected for `arm_var`, #' second variable will be nested under the first variable. +#' @param decorators `r roxygen_decorators_param("tm_t_events")` #' #' @inherit module_arguments return seealso #' +#' @section Decorating `tm_t_events`: +#' +#' This module generates the following objects, which can be modified in place using decorators: +#' - `table` (`TableTree` as created from `rtables::build_table`) +#' +#' 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 @@ -524,7 +533,8 @@ tm_t_events <- function(label, incl_overall_sum = TRUE, pre_output = NULL, post_output = NULL, - basic_table_args = teal.widgets::basic_table_args()) { + basic_table_args = teal.widgets::basic_table_args(), + decorators = NULL) { message("Initializing tm_t_events") checkmate::assert_string(label) checkmate::assert_string(dataname) @@ -545,6 +555,8 @@ tm_t_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(basic_table_args, "basic_table_args") + decorators <- normalize_decorators(decorators) + assert_decorators(decorators, "table", null.ok = TRUE) args <- as.list(environment()) @@ -570,7 +582,8 @@ tm_t_events <- function(label, na_level = na_level, sort_freq_col = sort_freq_col, incl_overall_sum = incl_overall_sum, - basic_table_args = basic_table_args + basic_table_args = basic_table_args, + decorators = decorators ) ), datanames = teal.transform::get_extract_datanames(data_extract_list) @@ -612,6 +625,7 @@ ui_t_events_byterm <- function(id, ...) { is_single_dataset = is_single_dataset_value ), checkboxInput(ns("add_total"), "Add All Patients columns", value = a$add_total), + ui_decorate_teal_data(ns("decorator"), decorators = select_decorators(a$decorators, "table")), teal.widgets::panel_item( "Additional table settings", checkboxInput( @@ -675,7 +689,8 @@ srv_t_events_byterm <- function(id, total_label, na_level, sort_freq_col, - basic_table_args) { + basic_table_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") @@ -808,10 +823,15 @@ srv_t_events_byterm <- function(id, teal.code::eval_code(merged$anl_q(), as.expression(unlist(my_calls))) }) + decorated_table_q <- srv_decorate_teal_data( + id = "decorator", + data = table_q, + decorators = select_decorators(decorators, "table"), + expr = table + ) + # Outputs to render. - table_r <- reactive({ - table_q()[["pruned_and_sorted_result"]] - }) + table_r <- reactive(decorated_table_q()[["table"]]) teal.widgets::table_with_settings_srv( id = "table", @@ -821,7 +841,7 @@ srv_t_events_byterm <- function(id, # Render R code. teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(table_q())), + verbatim_content = reactive(teal.code::get_code(req(decorated_table_q()))), title = label ) @@ -840,7 +860,7 @@ srv_t_events_byterm <- function(id, card$append_text("Comment", "header3") card$append_text(comment) } - card$append_src(teal.code::get_code(table_q())) + card$append_src(teal.code::get_code(req(decorated_table_q()))) card } teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) diff --git a/man/tm_t_events.Rd b/man/tm_t_events.Rd index 88c500d09..08a0a9768 100644 --- a/man/tm_t_events.Rd +++ b/man/tm_t_events.Rd @@ -24,7 +24,8 @@ tm_t_events( incl_overall_sum = TRUE, pre_output = NULL, post_output = NULL, - basic_table_args = teal.widgets::basic_table_args() + basic_table_args = teal.widgets::basic_table_args(), + decorators = NULL ) } \arguments{ @@ -88,6 +89,12 @@ For example the \code{\link[shiny:helpText]{shiny::helpText()}} elements are use with settings for the module table. The argument is merged with option \code{teal.basic_table_args} and with default module arguments (hard coded in the module body). For more details, see the vignette: \code{vignette("custom-basic-table-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_t_events}" below for more details.} } \value{ a \code{teal_module} object. @@ -95,6 +102,18 @@ a \code{teal_module} object. \description{ This module produces a table of events by term. } +\section{Decorating \code{tm_t_events}}{ + + +This module generates the following objects, which can be modified in place using decorators: +\itemize{ +\item \code{table} (\code{TableTree} as created from \code{rtables::build_table}) +} + +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{ data <- teal_data() data <- within(data, {