diff --git a/R/tm_t_crosstable.R b/R/tm_t_crosstable.R index 47d84bcfd..6f24574a1 100644 --- a/R/tm_t_crosstable.R +++ b/R/tm_t_crosstable.R @@ -25,6 +25,14 @@ #' #' @inherit shared_params return #' +#' @section Decorating `tm_t_crosstable`: +#' +#' This module generates the following objects, which can be modified in place using decorators: +#' - `table` (`ElementaryTable` - 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.general) #' interactive <- function() TRUE @@ -134,7 +142,8 @@ tm_t_crosstable <- function(label = "Cross Table", show_total = TRUE, pre_output = NULL, post_output = NULL, - basic_table_args = teal.widgets::basic_table_args()) { + basic_table_args = teal.widgets::basic_table_args(), + decorators = NULL) { message("Initializing tm_t_crosstable") # Requires Suggested packages @@ -158,6 +167,7 @@ tm_t_crosstable <- function(label = "Cross Table", checkmate::assert_multi_class(pre_output, c("shiny.tag", "shiny.tag.list", "html"), null.ok = TRUE) checkmate::assert_multi_class(post_output, c("shiny.tag", "shiny.tag.list", "html"), null.ok = TRUE) checkmate::assert_class(basic_table_args, classes = "basic_table_args") + checkmate::assert_list(decorators, "teal_transform_module", null.ok = TRUE) # End of assertions # Make UI args @@ -167,7 +177,8 @@ tm_t_crosstable <- function(label = "Cross Table", label = label, x = x, y = y, - basic_table_args = basic_table_args + basic_table_args = basic_table_args, + decorators = decorators ) ans <- module( @@ -184,6 +195,7 @@ tm_t_crosstable <- function(label = "Cross Table", # UI function for the cross-table module ui_t_crosstable <- function(id, x, y, show_percentage, show_total, pre_output, post_output, ...) { + args <- list(...) ns <- NS(id) is_single_dataset <- teal.transform::is_single_dataset(x, y) @@ -221,7 +233,8 @@ ui_t_crosstable <- function(id, x, y, show_percentage, show_total, pre_output, p checkboxInput(ns("show_percentage"), "Show column percentage", value = show_percentage), checkboxInput(ns("show_total"), "Show total column", value = show_total) ) - ) + ), + ui_teal_transform_data(ns("decorate"), transformators = args$decorators) ), forms = tagList( teal.widgets::verbatim_popup_ui(ns("rcode"), "Show R code") @@ -232,7 +245,7 @@ ui_t_crosstable <- function(id, x, y, show_percentage, show_total, pre_output, p } # Server function for the cross-table module -srv_t_crosstable <- function(id, data, reporter, filter_panel_api, label, x, y, basic_table_args) { +srv_t_crosstable <- function(id, data, reporter, filter_panel_api, label, x, y, basic_table_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") @@ -351,7 +364,7 @@ srv_t_crosstable <- function(id, data, reporter, filter_panel_api, label, x, y, teal.code::eval_code( substitute( expr = { - lyt <- basic_tables %>% + table <- basic_tables %>% split_call %>% # styler: off rtables::add_colcounts() %>% tern::analyze_vars( @@ -387,19 +400,22 @@ srv_t_crosstable <- function(id, data, reporter, filter_panel_api, label, x, y, substitute( expr = { ANL <- tern::df_explicit_na(ANL) - tbl <- rtables::build_table(lyt = lyt, df = ANL[order(ANL[[y_name]]), ]) - tbl + table <- rtables::build_table(lyt = table, df = ANL[order(ANL[[y_name]]), ]) }, env = list(y_name = y_name) ) ) }) + decorated_output_q_no_print <- srv_teal_transform_data("decorate", data = output_q, transformators = decorators) + decorated_output_q <- reactive(within(decorated_output_q_no_print(), expr = table)) + output$title <- renderText(output_q()[["title"]]) table_r <- reactive({ req(iv_r()$is_valid()) - output_q()[["tbl"]] + req(output_q()) + decorated_output_q()[["table"]] }) teal.widgets::table_with_settings_srv( @@ -409,7 +425,7 @@ srv_t_crosstable <- function(id, data, reporter, filter_panel_api, label, x, y, teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(output_q())), + verbatim_content = reactive(teal.code::get_code(req(decorated_output_q()))), title = "Show R Code for Cross-Table" ) @@ -428,7 +444,7 @@ srv_t_crosstable <- function(id, data, reporter, filter_panel_api, label, x, y, card$append_text("Comment", "header3") card$append_text(comment) } - card$append_src(teal.code::get_code(output_q())) + card$append_src(teal.code::get_code(req(decorated_output_q()))) card } teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) diff --git a/man/tm_t_crosstable.Rd b/man/tm_t_crosstable.Rd index 0d1175647..e48a73412 100644 --- a/man/tm_t_crosstable.Rd +++ b/man/tm_t_crosstable.Rd @@ -12,7 +12,8 @@ tm_t_crosstable( show_total = TRUE, pre_output = NULL, post_output = NULL, - basic_table_args = teal.widgets::basic_table_args() + basic_table_args = teal.widgets::basic_table_args(), + decorators = list(default = teal_transform_module()) ) } \arguments{ @@ -49,6 +50,9 @@ with settings for the module table. The argument is merged with options variable \code{teal.basic_table_args} and default module setup. For more details see the vignette: \code{vignette("custom-basic-table-arguments", package = "teal.widgets")}} + +\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}) optional, +decorator for tables or plots included in the module.} } \value{ Object of class \code{teal_module} to be used in \code{teal} applications. @@ -61,6 +65,18 @@ options for showing percentages and sub-totals. For more examples, please see the vignette "Using cross table" via \code{vignette("using-cross-table", package = "teal.modules.general")}. } +\section{Decorating \code{tm_t_crosstable}}{ + + +This module generates the following objects, which can be modified in place using decorators: +\itemize{ +\item \code{table} (\code{ElementaryTable} - output of \code{rtables::build_table}) +} + +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{ \dontshow{if (require("rtables", quietly = TRUE)) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} # general data example