diff --git a/R/tm_t_pp_medical_history.R b/R/tm_t_pp_medical_history.R
index b73235d39..881e77725 100644
--- a/R/tm_t_pp_medical_history.R
+++ b/R/tm_t_pp_medical_history.R
@@ -40,7 +40,7 @@ template_medical_history <- function(dataname = "ANL",
dplyr::distinct() %>%
`colnames<-`(labels)
- result <- rtables::basic_table() %>%
+ table <- rtables::basic_table() %>%
rtables::split_cols_by_multivar(colnames(result_raw)[2:3]) %>%
rtables::split_rows_by(
colnames(result_raw)[1],
@@ -54,9 +54,7 @@ template_medical_history <- function(dataname = "ANL",
rtables::analyze_colvars(function(x) x[seq_along(x)]) %>%
rtables::build_table(result_raw)
- main_title(result) <- paste("Patient ID:", patient_id)
-
- result
+ main_title(table) <- paste("Patient ID:", patient_id)
}, env = list(
dataname = as.name(dataname),
mhbodsys = as.name(mhbodsys),
@@ -88,6 +86,13 @@ template_medical_history <- function(dataname = "ANL",
#' available choices and preselected option for the `MHDISTAT` variable from `dataname`.
#'
#' @inherit module_arguments return
+#' @section Decorating Module:
+#'
+#' This module generates the following objects, which can be modified in place using decorators:
+#' - `table` (`TableTree` - 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.
#'
#' @examplesShinylive
#' library(teal.modules.clinical)
@@ -141,7 +146,8 @@ tm_t_pp_medical_history <- function(label,
mhbodsys = NULL,
mhdistat = NULL,
pre_output = NULL,
- post_output = NULL) {
+ post_output = NULL,
+ decorators = NULL) {
message("Initializing tm_t_pp_medical_history")
checkmate::assert_string(label)
checkmate::assert_string(dataname)
@@ -152,6 +158,8 @@ tm_t_pp_medical_history <- function(label,
checkmate::assert_class(mhdistat, "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(
@@ -171,7 +179,8 @@ tm_t_pp_medical_history <- function(label,
dataname = dataname,
parentname = parentname,
label = label,
- patient_col = patient_col
+ patient_col = patient_col,
+ decorators = decorators
)
),
datanames = c(dataname, parentname)
@@ -221,7 +230,8 @@ ui_t_medical_history <- function(id, ...) {
label = "Select MHDISTAT variable:",
data_extract_spec = ui_args$mhdistat,
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")
@@ -242,7 +252,8 @@ srv_t_medical_history <- function(id,
mhterm,
mhbodsys,
mhdistat,
- 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")
@@ -303,6 +314,7 @@ srv_t_medical_history <- function(id,
teal.code::eval_code(as.expression(anl_inputs()$expr))
})
+ # Generate r code for the analysis.
all_q <- reactive({
teal::validate_inputs(iv_r())
@@ -335,16 +347,27 @@ srv_t_medical_history <- function(id,
teal.code::eval_code(as.expression(unlist(my_calls)))
})
- table_r <- reactive(all_q()[["result"]])
+ # Decoration of table output.
+ 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(decorated_table_q()[["table"]])
teal.widgets::table_with_settings_srv(
id = "table",
table_r = table_r
)
+ # Render R code.
+ 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
)
@@ -363,7 +386,7 @@ srv_t_medical_history <- function(id,
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_medical_history.Rd b/man/tm_t_pp_medical_history.Rd
index 0de76f252..4b07402ec 100644
--- a/man/tm_t_pp_medical_history.Rd
+++ b/man/tm_t_pp_medical_history.Rd
@@ -13,7 +13,8 @@ tm_t_pp_medical_history(
mhbodsys = NULL,
mhdistat = NULL,
pre_output = NULL,
- post_output = NULL
+ post_output = NULL,
+ decorators = NULL
)
}
\arguments{
@@ -39,6 +40,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.
@@ -46,6 +56,40 @@ a \code{teal_module} object.
\description{
This module produces a patient profile medical history 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_listing} (\code{listing_df} - output of \code{rlistings::as_listing})
+\itemize{
+\item Only used in reporter
+}
+\item \code{table_dt} (\code{datatable} - output of \code{DT::datatable})
+\itemize{
+\item Not used in reporter
+}
+}
+
+Decorators can be applied to all outputs or only to specific objects using a
+named list of \code{teal_transform_module} objects.
+The \code{"default"} name is reserved for decorators that are applied to all outputs.
+See code snippet below:
+
+\if{html}{\out{}}\preformatted{tm_t_pp_laboratory(
+ ..., # arguments for module
+ decorators = list(
+ default = list(teal_transform_module(...)), # applied to all outputs
+ table_listing = list(teal_transform_module(...)), # applied only to `table_listing` output
+ table_dt = list(teal_transform_module(...)) # applied only to `table_dt` output
+ )
+)
+}\if{html}{\out{
}}
+
+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, {
@@ -89,8 +133,8 @@ if (interactive()) {
\describe{
\item{example-1}{
\href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMBOhFoFuASgA60snGYFStAG5wABAB4AtDoBmgiOtol2cnQBUsAVQCiSpfyiko+o12oB9d09rNw8vQx0Ad1pSAAtaCHZAqFwdECUdHQBBABEAZQAZbx1SGAI-OAAPPyh+UWp0rOyAWQAJIpKyyur+GBilAF9FCAArIni-AGs4VlFE0Jtw-jhjKGFSPwJ+WlEy0fGpmeBoeFmkuQBdVwgcgqKk4GAFMBv8p-PL6+a2xdCHp5zWm8Pko0KgivFouwGkkdABeHRJXANPhCESiOE6FHCMRQiAZDIlPzrdB+eBbWT+OKiUhENi4-H46hQehwagYp5NODk7g6FrbGlsJ5IvEMhGhY66eH-L5ChoM1AsCikCXs555V54OX4hUaJUbIhsqVgBy5BwAIQAUgBJbKykUM3rkRgwDEEGJjAhiPyiVlwdRc+mijJuj1iDGaFi0ZkiDbumQ4gEtFIEKFgVq2JxYJpPORyYVBjI+kT+-iq9OZ7NgLUZPPVzExegCUQzV1xz2ib2+kuBoMh+Po+ERxhR+gxvvt9iJlIclpmgDyeQAmrkc-mC0W-eRS0bWvOlyuq-b8bWjxleltqR5W6GOxvu3Xg22w4PI9G4LGb5OvtO0y1slbclsTJbFXB8dDvLcyz-ACgJAw8gyGBlEJ0IYhloYwdHYeInSgCxtGsGw0hFUQ4ggVhMnQdhQQAEkEWgUhon1GG0Rghn6JQwH6c4gA}{Open in Shinylive}
- \if{html}{\out{}}
- \if{html}{\out{}}
+ \if{html}{\out{}}
+ \if{html}{\out{}}
}
}
}