From 582ceb39df6c604c0af83d7db0d46aaee4c15368 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Tue, 10 Dec 2024 16:50:06 +0000 Subject: [PATCH] Adds decorators to `tm_t_shift_by_arm_by_worst` (#1286) Part of https://github.com/insightsengineering/teal/issues/1371
Working example ```r pkgload::load_all("../teal.modules.clinical", export_all = FALSE) # Example below 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))) ) ) } data <- teal_data() data <- within(data, { ADSL <- tmc_ex_adsl ADEG <- tmc_ex_adeg }) join_keys(data) <- default_cdisc_join_keys[names(data)] ADSL <- data[["ADSL"]] ADEG <- data[["ADEG"]] init( data = data, modules = modules( tm_t_shift_by_arm_by_worst( label = "Shift by Arm Table", dataname = "ADEG", arm_var = choices_selected( variable_choices(ADSL, subset = c("ARM", "ARMCD")), selected = "ARM" ), paramcd = choices_selected( value_choices(ADEG, "PARAMCD"), selected = "ECGINTP" ), worst_flag_var = choices_selected( variable_choices(ADEG, c("WORS02FL", "WORS01FL")), selected = "WORS02FL" ), worst_flag = choices_selected( value_choices(ADEG, "WORS02FL"), selected = "Y", fixed = TRUE ), aval_var = choices_selected( variable_choices(ADEG, c("AVALC", "ANRIND")), selected = "AVALC" ), baseline_var = choices_selected( variable_choices(ADEG, c("BASEC", "BNRIND")), selected = "BASEC" ), useNA = "ifany", decorators = list(insert_rrow_decorator()) ) ) ) |> shiny::runApp() ```
--------- Co-authored-by: Marcin <133694481+m7pr@users.noreply.github.com> --- R/tm_t_shift_by_arm_by_worst.R | 42 +++++++++++++++++++++++-------- man/tm_t_shift_by_arm_by_worst.Rd | 24 +++++++++++++++++- 2 files changed, 55 insertions(+), 11 deletions(-) diff --git a/R/tm_t_shift_by_arm_by_worst.R b/R/tm_t_shift_by_arm_by_worst.R index a1a813d29..005d86bd0 100644 --- a/R/tm_t_shift_by_arm_by_worst.R +++ b/R/tm_t_shift_by_arm_by_worst.R @@ -179,8 +179,7 @@ template_shift_by_arm_by_worst <- function(dataname, # Full table. y$table <- substitute( expr = { - result <- rtables::build_table(lyt = lyt, df = dataname) - result + table <- rtables::build_table(lyt = lyt, df = dataname) }, env = list(dataname = as.name(dataname)) ) @@ -197,6 +196,14 @@ template_shift_by_arm_by_worst <- function(dataname, #' #' @inherit module_arguments return #' +#' @section Decorating Module: +#' +#' This module generates the following objects, which can be modified in place using decorators: +#' - `table` (`TableTree` - output of `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 @@ -278,7 +285,8 @@ tm_t_shift_by_arm_by_worst <- function(label, total_label = default_total_label(), pre_output = NULL, post_output = NULL, - basic_table_args = teal.widgets::basic_table_args()) { + basic_table_args = teal.widgets::basic_table_args(), + decorators = NULL) { if (lifecycle::is_present(base_var)) { baseline_var <- base_var warning( @@ -307,8 +315,10 @@ tm_t_shift_by_arm_by_worst <- 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") - args <- as.list(environment()) + decorators <- normalize_decorators(decorators) + assert_decorators(decorators, null.ok = TRUE, "table") + args <- as.list(environment()) data_extract_list <- list( arm_var = cs_to_des_select(arm_var, dataname = parentname), @@ -334,7 +344,8 @@ tm_t_shift_by_arm_by_worst <- function(label, treatment_flag = treatment_flag, total_label = total_label, na_level = na_level, - basic_table_args = basic_table_args + basic_table_args = basic_table_args, + decorators = decorators ) ), datanames = teal.transform::get_extract_datanames(data_extract_list) @@ -412,6 +423,7 @@ ui_shift_by_arm_by_worst <- function(id, ...) { choices = c("ifany", "no"), selected = a$useNA ), + ui_decorate_teal_data(ns("decorator"), decorators = select_decorators(a$decorators, "table")), teal.widgets::panel_group( teal.widgets::panel_item( "Additional Variables Info", @@ -456,7 +468,8 @@ srv_shift_by_arm_by_worst <- function(id, na_level, add_total, total_label, - 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") @@ -572,7 +585,7 @@ srv_shift_by_arm_by_worst <- function(id, ) }) - # generate r code for the analysis + # Generate r code for the analysis. all_q <- reactive({ validate_checks() @@ -597,8 +610,16 @@ srv_shift_by_arm_by_worst <- function(id, teal.code::eval_code(merged$anl_q(), as.expression(unlist(my_calls))) }) + # Decoration of table output + decorated_table_q <- srv_decorate_teal_data( + id = "decorator", + data = all_q, + decorators = select_decorators(decorators, "table"), + expr = table + ) + # Outputs to render. - table_r <- reactive(all_q()[["result"]]) + table_r <- reactive(decorated_table_q()[["table"]]) teal.widgets::table_with_settings_srv( id = "table", @@ -606,9 +627,10 @@ srv_shift_by_arm_by_worst <- function(id, ) # Render R code. + source_code_r <- reactive(teal.code::get_code(req(decorated_table_q()))) teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(all_q())), + verbatim_content = source_code_r, title = label ) @@ -627,7 +649,7 @@ srv_shift_by_arm_by_worst <- function(id, card$append_text("Comment", "header3") card$append_text(comment) } - card$append_src(teal.code::get_code(all_q())) + card$append_src(source_code_r()) card } teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) diff --git a/man/tm_t_shift_by_arm_by_worst.Rd b/man/tm_t_shift_by_arm_by_worst.Rd index 4672fa128..6d7823f39 100644 --- a/man/tm_t_shift_by_arm_by_worst.Rd +++ b/man/tm_t_shift_by_arm_by_worst.Rd @@ -25,7 +25,8 @@ tm_t_shift_by_arm_by_worst( total_label = default_total_label(), 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{ @@ -83,6 +84,15 @@ 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 Module" below for more details.} } \value{ a \code{teal_module} object. @@ -90,6 +100,18 @@ a \code{teal_module} object. \description{ This module produces a summary table of worst analysis indicator variable level per subject by arm. } +\section{Decorating Module}{ + + +This module generates the following objects, which can be modified in place using decorators: +\itemize{ +\item \code{table} (\code{TableTree} - output of \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, {