From 93c6af50de61458e6ee0f2f9de6d5c8ee8b72c6b Mon Sep 17 00:00:00 2001 From: m7pr Date: Wed, 27 Nov 2024 10:48:00 +0100 Subject: [PATCH] introduce decorators for `tm_g_pp_vitals` --- R/tm_g_pp_vitals.R | 45 ++++++++++++++++++++++++++++++++++++--------- 1 file changed, 36 insertions(+), 9 deletions(-) diff --git a/R/tm_g_pp_vitals.R b/R/tm_g_pp_vitals.R index 8721b153a..84ed2e0d2 100644 --- a/R/tm_g_pp_vitals.R +++ b/R/tm_g_pp_vitals.R @@ -123,7 +123,7 @@ template_vitals <- function(dataname = "ANL", color = paramcd_levels_e ) - result_plot <- ggplot2::ggplot(data = vitals, mapping = ggplot2::aes(x = xaxis)) + # replaced VSDY + plot <- ggplot2::ggplot(data = vitals, mapping = ggplot2::aes(x = xaxis)) + # replaced VSDY ggplot2::geom_line( data = vitals, mapping = ggplot2::aes(y = aval_var, color = paramcd), @@ -172,8 +172,6 @@ template_vitals <- function(dataname = "ANL", labs + ggthemes + themes - - print(result_plot) }, env = list( dataname = as.name(dataname), @@ -211,6 +209,16 @@ template_vitals <- function(dataname = "ANL", #' #' @inherit module_arguments return #' +#' +#' @section Decorating `tm_g_pp_vitals`: +#' +#' This module generates the following objects, which can be modified in place using decorators: +#' - `plot` (`ggplot2`) +#' +#' 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 @@ -271,7 +279,8 @@ tm_g_pp_vitals <- 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) { if (lifecycle::is_present(aval)) { aval_var <- aval warning( @@ -307,6 +316,15 @@ tm_g_pp_vitals <- function(label, checkmate::assert_multi_class(aval_var, c("choices_selected", "data_extract_spec"), null.ok = TRUE) checkmate::assert_multi_class(xaxis, c("choices_selected", "data_extract_spec"), null.ok = TRUE) + if (checkmate::test_list(decorators, "teal_transform_module", null.ok = TRUE)) { + decorators <- if (checkmate::test_names(names(decorators), subset.of = c("default", "plot"))) { + lapply(decorators, list) + } else { + list(default = decorators) + } + } + assert_decorators(decorators, null.ok = TRUE, names = c("default", "plot")) + args <- as.list(environment()) data_extract_list <- list( paramcd = `if`(is.null(paramcd), NULL, cs_to_des_select(paramcd, dataname = dataname)), @@ -328,7 +346,8 @@ tm_g_pp_vitals <- 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) @@ -378,6 +397,7 @@ ui_g_vitals <- function(id, ...) { data_extract_spec = ui_args$aval_var, is_single_dataset = is_single_dataset_value ), + ui_decorate_teal_data(ns("decorator"), decorators = subset_decorators("plot", ui_args$decorators)), teal.widgets::panel_item( title = "Plot settings", collapsed = TRUE, @@ -409,7 +429,8 @@ srv_g_vitals <- 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") @@ -553,7 +574,13 @@ srv_g_vitals <- function(id, teal.code::eval_code(as.expression(unlist(my_calls))) }) - plot_r <- reactive(all_q()[["result_plot"]]) + decorated_all_q <- srv_decorate_teal_data( + id = "decorator", + data = all_q, + decorators = subset_decorators("plot", decorators), + expr = print(plot) + ) + plot_r <- reactive(decorated_all_q()[["plot"]]) pws <- teal.widgets::plot_with_settings_srv( id = "vitals_plot", @@ -564,7 +591,7 @@ srv_g_vitals <- 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()))), title = label ) @@ -583,7 +610,7 @@ srv_g_vitals <- function(id, 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()))) card } teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)