diff --git a/R/tm_t_pp_basic_info.R b/R/tm_t_pp_basic_info.R index 7f61d4148..7a6f2bcfa 100644 --- a/R/tm_t_pp_basic_info.R +++ b/R/tm_t_pp_basic_info.R @@ -36,13 +36,11 @@ template_basic_info <- function(dataname = "ANL", dplyr::select(var, key, value) %>% dplyr::rename(` ` = var, ` ` = key, ` ` = value) - result <- rlistings::as_listing( + table <- rlistings::as_listing( result, default_formatting = list(all = fmt_config(align = "left")) ) - main_title(result) <- paste("Patient ID:", patient_id) - - result + main_title(table) <- paste("Patient ID:", patient_id) }, env = list( dataname = as.name(dataname), vars = vars, @@ -66,6 +64,14 @@ template_basic_info <- function(dataname = "ANL", #' #' @inherit module_arguments return #' +#' @section Decorating Module: +#' +#' This module generates the following objects, which can be modified in place using decorators: +#' - `table` (`listing_df` - output of `rlistings::as_listing`) +#' +#' 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 @@ -104,7 +110,8 @@ tm_t_pp_basic_info <- function(label, patient_col = "USUBJID", vars = NULL, pre_output = NULL, - post_output = NULL) { + post_output = NULL, + decorators = NULL) { message("Initializing tm_t_pp_basic_info") checkmate::assert_string(label) checkmate::assert_string(dataname) @@ -112,6 +119,8 @@ tm_t_pp_basic_info <- function(label, checkmate::assert_class(vars, "choices_selected", null.ok = TRUE) checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE) checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE) + decorators <- normalize_decorators(decorators) + assert_decorators(decorators, null.ok = TRUE, "table") args <- as.list(environment()) data_extract_list <- list( @@ -128,7 +137,8 @@ tm_t_pp_basic_info <- function(label, list( dataname = dataname, label = label, - patient_col = patient_col + patient_col = patient_col, + decorators = decorators ) ), datanames = dataname @@ -163,7 +173,8 @@ ui_t_basic_info <- function(id, ...) { label = "Select variable:", data_extract_spec = ui_args$vars, is_single_dataset = is_single_dataset_value - ) + ), + ui_decorate_teal_data(ns("decorator"), decorators = select_decorators(ui_args$decorators, "table")), ), forms = tagList( teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code") @@ -181,7 +192,8 @@ srv_t_basic_info <- function(id, dataname, patient_col, vars, - label) { + label, + decorators) { with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") checkmate::assert_class(data, "reactive") @@ -265,11 +277,18 @@ srv_t_basic_info <- function(id, teal.code::eval_code(as.expression(unlist(my_calls))) }) + decorated_table_q <- srv_decorate_teal_data( + id = "decorator", + data = all_q, + decorators = select_decorators(decorators, "table"), + expr = table + ) + output$title <- renderText({ paste("
Patient ID:", all_q()[["pt_id"]], "
") }) - table_r <- reactive(all_q()[["result"]]) + table_r <- reactive(decorated_table_q()[["table"]]) output$basic_info_table <- DT::renderDataTable( expr = table_r(), @@ -278,9 +297,10 @@ srv_t_basic_info <- function(id, ) ) + 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 ) @@ -294,12 +314,12 @@ srv_t_basic_info <- function(id, filter_panel_api = filter_panel_api ) card$append_text("Table", "header3") - card$append_table(table_r()) + card$append_table(decorated_table_q()[["table"]]) if (!comment == "") { 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_pp_basic_info.Rd b/man/tm_t_pp_basic_info.Rd index 9138d5e51..817a27fdd 100644 --- a/man/tm_t_pp_basic_info.Rd +++ b/man/tm_t_pp_basic_info.Rd @@ -10,7 +10,8 @@ tm_t_pp_basic_info( patient_col = "USUBJID", vars = NULL, pre_output = NULL, - post_output = NULL + post_output = NULL, + decorators = NULL ) } \arguments{ @@ -28,6 +29,15 @@ For example a title.} \item{post_output}{(\code{shiny.tag}) optional,\cr with text placed after the output to put the output into context. For example the \code{\link[shiny:helpText]{shiny::helpText()}} elements are useful.} + +\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. @@ -35,6 +45,18 @@ a \code{teal_module} object. \description{ This module produces a patient profile basic info report using ADaM datasets. } +\section{Decorating Module}{ + + +This module generates the following objects, which can be modified in place using decorators: +\itemize{ +\item \code{table} (\code{listing_df} - output of \code{rlistings::as_listing}) +} + +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, {