From 382b318642a4595d527b17de5094fbba20897b3c Mon Sep 17 00:00:00 2001 From: m7pr Date: Wed, 27 Nov 2024 10:17:44 +0100 Subject: [PATCH 1/5] introduce decorators for `tm_t_abnormality_by_worst_grade` --- R/tm_t_abnormality_by_worst_grade.R | 43 +++++++++++++++++++++++------ 1 file changed, 35 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..f2470cec5 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) @@ -356,6 +364,15 @@ tm_t_abnormality_by_worst_grade <- function(label, # nolint: object_length. checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE) checkmate::assert_class(basic_table_args, "basic_table_args") + if (checkmate::test_list(decorators, "teal_transform_module", null.ok = TRUE)) { + decorators <- if (checkmate::test_names(names(decorators), subset.of = c("default", "table"))) { + lapply(decorators, list) + } else { + list(default = decorators) + } + } + assert_decorators(decorators, null.ok = TRUE, names = c("default", "table")) + data_extract_list <- list( arm_var = cs_to_des_select(arm_var, dataname = parentname), id_var = cs_to_des_select(id_var, dataname = dataname), @@ -380,7 +397,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 +470,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 = subset_decorators("table", a$decorators)), teal.widgets::panel_group( teal.widgets::panel_item( "Additional table settings", @@ -501,7 +520,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 +684,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 = subset_decorators("table", decorators), + 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 +702,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 +722,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) From 32537d9000cdf99eb51c6b53659b79bdfb119891 Mon Sep 17 00:00:00 2001 From: m7pr Date: Wed, 27 Nov 2024 10:33:17 +0100 Subject: [PATCH 2/5] edit reporter part --- R/tm_t_abnormality_by_worst_grade.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/tm_t_abnormality_by_worst_grade.R b/R/tm_t_abnormality_by_worst_grade.R index f2470cec5..357e7dc9c 100644 --- a/R/tm_t_abnormality_by_worst_grade.R +++ b/R/tm_t_abnormality_by_worst_grade.R @@ -717,7 +717,7 @@ srv_t_abnormality_by_worst_grade <- function(id, # nolint: object_length. filter_panel_api = filter_panel_api ) card$append_text("Table", "header3") - card$append_table(table_r()) + card$append_table(req(decorated_table_q()))) if (!comment == "") { card$append_text("Comment", "header3") card$append_text(comment) From dbec0815ebae98b7709b29e9cbd1aa5b02857a74 Mon Sep 17 00:00:00 2001 From: m7pr Date: Wed, 27 Nov 2024 10:37:37 +0100 Subject: [PATCH 3/5] revert changes for reporter --- R/tm_t_abnormality_by_worst_grade.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/tm_t_abnormality_by_worst_grade.R b/R/tm_t_abnormality_by_worst_grade.R index 357e7dc9c..f2470cec5 100644 --- a/R/tm_t_abnormality_by_worst_grade.R +++ b/R/tm_t_abnormality_by_worst_grade.R @@ -717,7 +717,7 @@ srv_t_abnormality_by_worst_grade <- function(id, # nolint: object_length. filter_panel_api = filter_panel_api ) card$append_text("Table", "header3") - card$append_table(req(decorated_table_q()))) + card$append_table(table_r()) if (!comment == "") { card$append_text("Comment", "header3") card$append_text(comment) From 8a7b6bd6cd1b6954e42b18d1646531459c61506a Mon Sep 17 00:00:00 2001 From: m7pr Date: Wed, 27 Nov 2024 21:51:46 +0100 Subject: [PATCH 4/5] use normalize_decorators --- R/tm_t_abnormality_by_worst_grade.R | 11 ++--------- 1 file changed, 2 insertions(+), 9 deletions(-) diff --git a/R/tm_t_abnormality_by_worst_grade.R b/R/tm_t_abnormality_by_worst_grade.R index f2470cec5..dd587b84e 100644 --- a/R/tm_t_abnormality_by_worst_grade.R +++ b/R/tm_t_abnormality_by_worst_grade.R @@ -363,15 +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") - - if (checkmate::test_list(decorators, "teal_transform_module", null.ok = TRUE)) { - decorators <- if (checkmate::test_names(names(decorators), subset.of = c("default", "table"))) { - lapply(decorators, list) - } else { - list(default = decorators) - } - } - assert_decorators(decorators, null.ok = TRUE, names = c("default", "table")) + 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), From 64fc38f04713ae41aa32689252259e89078f4570 Mon Sep 17 00:00:00 2001 From: m7pr Date: Thu, 28 Nov 2024 15:43:26 +0100 Subject: [PATCH 5/5] change subset to select --- R/tm_t_abnormality_by_worst_grade.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/tm_t_abnormality_by_worst_grade.R b/R/tm_t_abnormality_by_worst_grade.R index dd587b84e..fc0740c93 100644 --- a/R/tm_t_abnormality_by_worst_grade.R +++ b/R/tm_t_abnormality_by_worst_grade.R @@ -463,7 +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 = subset_decorators("table", a$decorators)), + ui_decorate_teal_data(ns("decorator"), decorators = select_decorators(a$decorators, "table")), teal.widgets::panel_group( teal.widgets::panel_item( "Additional table settings", @@ -680,7 +680,7 @@ srv_t_abnormality_by_worst_grade <- function(id, # nolint: object_length. decorated_table_q <- srv_decorate_teal_data( id = "decorator", data = all_q, - decorators = subset_decorators("table", decorators), + decorators = select_decorators(decorators, "table"), expr = table )