From e3bc080be10444d58de759aa44693119dd02d785 Mon Sep 17 00:00:00 2001 From: Marcin <133694481+m7pr@users.noreply.github.com> Date: Fri, 29 Nov 2024 21:27:01 +0100 Subject: [PATCH] introduce decorators for `tm_t_abnormality_by_worst_grade` (#1260) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Part of https://github.com/insightsengineering/teal/issues/1371
Working Example ```r devtools::load_all("../teal") devtools::load_all(".") 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))) ) ) } library(dplyr) data <- teal_data() data <- within(data, { ADSL <- tmc_ex_adsl ADLB <- tmc_ex_adlb %>% filter(!AVISIT %in% c("SCREENING", "BASELINE")) }) join_keys(data) <- default_cdisc_join_keys[names(data)] ADSL <- data[["ADSL"]] ADLB <- data[["ADLB"]] app <- init( data = data, modules = modules( tm_t_abnormality_by_worst_grade( label = "Laboratory Test Results with Highest Grade Post-Baseline", dataname = "ADLB", arm_var = choices_selected( choices = variable_choices(ADSL, subset = c("ARM", "ARMCD")), selected = "ARM" ), paramcd = choices_selected( choices = value_choices(ADLB, "PARAMCD", "PARAM"), selected = c("ALT", "CRP", "IGA") ), add_total = FALSE, decorators = list(insert_rrow_decorator("I am a good new row")) ) ), filter = teal_slices( teal_slice("ADSL", "SAFFL", selected = "Y"), teal_slice("ADLB", "ONTRTFL", selected = "Y") ) ) if (interactive()) { shinyApp(app$ui, app$server) } ```
--------- Co-authored-by: Lluís Revilla <185338939+llrs-roche@users.noreply.github.com> --- R/tm_t_abnormality_by_worst_grade.R | 36 ++++++++++++++++++++++------- 1 file changed, 28 insertions(+), 8 deletions(-) diff --git a/R/tm_t_abnormality_by_worst_grade.R b/R/tm_t_abnormality_by_worst_grade.R index 979f7ea58..fc0740c93 100644 --- a/R/tm_t_abnormality_by_worst_grade.R +++ b/R/tm_t_abnormality_by_worst_grade.R @@ -221,8 +221,7 @@ template_abnormality_by_worst_grade <- function(parentname, # nolint: object_len y$table <- substitute( expr = { - result <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = parent) - result + table <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = parent) }, env = list(parent = as.name(parentname)) ) @@ -249,6 +248,14 @@ template_abnormality_by_worst_grade <- function(parentname, # nolint: object_len #' #' @inherit module_arguments return seealso #' +#' @section Decorating `tm_t_abnormality_by_worst_grade`: +#' +#' This module generates the following objects, which can be modified in place using decorators: +#' - `table` (`ElementaryTable` - 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. +#' #' @export #' #' @examplesShinylive @@ -339,7 +346,8 @@ tm_t_abnormality_by_worst_grade <- function(label, # nolint: object_length. drop_arm_levels = 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_abnormality_by_worst_grade") checkmate::assert_string(label) checkmate::assert_string(dataname) @@ -355,6 +363,8 @@ tm_t_abnormality_by_worst_grade <- function(label, # nolint: object_length. 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, null.ok = TRUE, "table") data_extract_list <- list( arm_var = cs_to_des_select(arm_var, dataname = parentname), @@ -380,7 +390,8 @@ tm_t_abnormality_by_worst_grade <- function(label, # nolint: object_length. label = label, worst_flag_indicator = worst_flag_indicator, total_label = total_label, - basic_table_args = basic_table_args + basic_table_args = basic_table_args, + decorators = decorators ) ), datanames = teal.transform::get_extract_datanames(data_extract_list) @@ -452,6 +463,7 @@ ui_t_abnormality_by_worst_grade <- function(id, ...) { # nolint: object_length. data_extract_spec = a$worst_high_flag_var, is_single_dataset = is_single_dataset_value ), + ui_decorate_teal_data(ns("decorator"), decorators = select_decorators(a$decorators, "table")), teal.widgets::panel_group( teal.widgets::panel_item( "Additional table settings", @@ -501,7 +513,8 @@ srv_t_abnormality_by_worst_grade <- function(id, # nolint: object_length. total_label, drop_arm_levels, 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") @@ -664,8 +677,15 @@ srv_t_abnormality_by_worst_grade <- function(id, # nolint: object_length. teal.code::eval_code(merged$anl_q(), as.expression(unlist(my_calls))) }) + 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", @@ -675,7 +695,7 @@ srv_t_abnormality_by_worst_grade <- function(id, # nolint: object_length. # Render R code. 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_table_q()))), title = label ) @@ -695,7 +715,7 @@ srv_t_abnormality_by_worst_grade <- function(id, # nolint: object_length. 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_table_q()))) card } teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)