diff --git a/R/tm_g_pp_therapy.R b/R/tm_g_pp_therapy.R index ca6b9cb3c..2f8fac209 100644 --- a/R/tm_g_pp_therapy.R +++ b/R/tm_g_pp_therapy.R @@ -65,7 +65,7 @@ template_therapy <- function(dataname = "ANL", dataname[setdiff(cols_to_include, names(dataname))] <- NA - therapy_table <- dataname %>% + table <- dataname %>% dplyr::filter(atirel %in% c("CONCOMITANT", "PRIOR")) %>% # removed PRIOR_CONCOMITANT dplyr::select(dplyr::all_of(cols_to_include)) %>% dplyr::filter(!is.na(cmdecod)) %>% @@ -84,14 +84,13 @@ template_therapy <- function(dataname = "ANL", col_labels(dataname, fill = TRUE)[c(cmstdy_char, cmendy_char)] )) - therapy_table <- rlistings::as_listing( - therapy_table, + table <- rlistings::as_listing( + table, key_cols = NULL, default_formatting = list(all = fmt_config(align = "left")) ) - main_title(therapy_table) <- paste("Patient ID:", patient_id) + main_title(table) <- paste("Patient ID:", patient_id) - therapy_table }, env = list( dataname = as.name(dataname), atirel = as.name(atirel), @@ -173,7 +172,7 @@ template_therapy <- function(dataname = "ANL", TRUE ~ as.character(cmdecod) )) - therapy_plot <- + plot <- ggplot2::ggplot(data = data, ggplot2::aes(fill = cmindc, color = cmindc, y = CMDECOD, x = CMSTDY)) + ggplot2::geom_segment(ggplot2::aes(xend = CMENDY, yend = CMDECOD), size = 2) + ggplot2::geom_text( @@ -192,7 +191,6 @@ template_therapy <- function(dataname = "ANL", ggtheme + theme - therapy_plot }, env = c( list( dataname = as.name(dataname), @@ -247,6 +245,31 @@ template_therapy <- function(dataname = "ANL", #' #' @inherit module_arguments return #' +#' @section Decorating `tm_g_pp_therapy`: +#' +#' 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_therapy( +#' ..., # 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 @@ -347,7 +370,8 @@ tm_g_pp_therapy <- 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_therapy") checkmate::assert_class(atirel, "choices_selected", null.ok = TRUE) checkmate::assert_class(cmdecod, "choices_selected", null.ok = TRUE) @@ -375,6 +399,8 @@ tm_g_pp_therapy <- 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, null.ok = TRUE, names = c('plot', 'table')) args <- as.list(environment()) data_extract_list <- list( @@ -404,7 +430,8 @@ tm_g_pp_therapy <- 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) @@ -510,6 +537,8 @@ ui_g_therapy <- function(id, ...) { data_extract_spec = ui_args$cmendy, 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, @@ -551,7 +580,8 @@ srv_g_therapy <- 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") @@ -673,16 +703,30 @@ srv_g_therapy <- function(id, paste("
Patient ID:", all_q()[["pt_id"]], "
") }) + decorated_all_q_table <- srv_decorate_teal_data( + "d_table", + data = all_q, + decorators = select_decorators(decorators, "table"), + expr = table + ) + output$therapy_table <- DT::renderDataTable( expr = { - teal.code::dev_suppress(all_q()[["therapy_table"]]) + teal.code::dev_suppress(decorated_all_q_table()[["table"]]) }, options = list(pageLength = input$therapy_table_rows) ) + decorated_all_q_plot <- srv_decorate_teal_data( + "d_plot", + data = decorated_all_q_table, + decorators = select_decorators(decorators, "plot"), + expr = print(plot) + ) + plot_r <- reactive({ req(iv_r()$is_valid()) - all_q()[["therapy_plot"]] + decorated_all_q_plot()[["plot"]] }) pws <- teal.widgets::plot_with_settings_srv( @@ -694,7 +738,7 @@ srv_g_therapy <- function(id, 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_plot()))), title = label ) @@ -708,14 +752,14 @@ srv_g_therapy <- function(id, filter_panel_api = filter_panel_api ) card$append_text("Table", "header3") - card$append_table(teal.code::dev_suppress(all_q()[["therapy_table"]])) + card$append_table(teal.code::dev_suppress(all_q()[["table"]])) 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_plot()))) card } teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)