From bd975e5c07e6db594e7817af0d766e29df7a35de Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Mon, 9 Dec 2024 14:20:33 +0000 Subject: [PATCH] Adds decorators to `tm_t_pp_medical_history` (#1289) Part of https://github.com/insightsengineering/teal/issues/1371
Working example ```r pkgload::load_all("../teal.modules.clinical", export_all = FALSE) # Example below rlisting_footer <- function(default_footer = "I am a good footer", .var_to_replace = "table_listing") { teal_transform_module( label = "New row", ui = function(id) shiny::textInput(shiny::NS(id, "footer"), "footer", value = default_footer), server = make_teal_transform_server( substitute({ rlistings::main_footer(.var_to_replace) <- footer }, env = list(.var_to_replace = as.name(.var_to_replace))) ) ) } data <- teal_data() data <- within(data, { ADSL <- tmc_ex_adsl ADMH <- tmc_ex_admh }) join_keys(data) <- default_cdisc_join_keys[names(data)] ADSL <- data[["ADSL"]] ADMH <- data[["ADMH"]] app <- init( data = data, modules = modules( tm_t_pp_medical_history( label = "Medical History", dataname = "ADMH", parentname = "ADSL", patient_col = "USUBJID", mhterm = choices_selected( choices = variable_choices(ADMH, c("MHTERM")), selected = "MHTERM" ), mhbodsys = choices_selected( choices = variable_choices(ADMH, "MHBODSYS"), selected = "MHBODSYS" ), mhdistat = choices_selected( choices = variable_choices(ADMH, "MHDISTAT"), selected = "MHDISTAT" ), decorators = list(insert_rrow_decorator()) ) ) ) |> shiny::runApp() ```
--------- Co-authored-by: Marcin <133694481+m7pr@users.noreply.github.com> --- R/tm_t_pp_medical_history.R | 45 ++++++++++++++++++++++-------- man/tm_t_pp_medical_history.Rd | 50 ++++++++++++++++++++++++++++++++-- 2 files changed, 81 insertions(+), 14 deletions(-) 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{}} } } }