diff --git a/R/tm_data_table.R b/R/tm_data_table.R index 2a688f7d7..657d5bf6d 100644 --- a/R/tm_data_table.R +++ b/R/tm_data_table.R @@ -29,6 +29,14 @@ #' #' @inherit shared_params return #' +#' @section Decorating `tm_data_table`: +#' +#' This module generates the following objects, which can be modified in place using decorators: +#' - `table` ([DT::datatable()]) +#' +#' 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 @@ -96,7 +104,8 @@ tm_data_table <- function(label = "Data Table", ), server_rendering = FALSE, pre_output = NULL, - post_output = NULL) { + post_output = NULL, + decorators = NULL) { message("Initializing tm_data_table") # Start of assertions @@ -121,6 +130,8 @@ tm_data_table <- function(label = "Data Table", checkmate::assert_flag(server_rendering) 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_list(decorators, "teal_transform_module", null.ok = TRUE) # End of assertions ans <- module( @@ -133,7 +144,8 @@ tm_data_table <- function(label = "Data Table", datasets_selected = datasets_selected, dt_args = dt_args, dt_options = dt_options, - server_rendering = server_rendering + server_rendering = server_rendering, + decorators = decorators ), ui_args = list( pre_output = pre_output, @@ -145,9 +157,7 @@ tm_data_table <- function(label = "Data Table", } # UI page module -ui_page_data_table <- function(id, - pre_output = NULL, - post_output = NULL) { +ui_page_data_table <- function(id, pre_output = NULL, post_output = NULL) { ns <- NS(id) tagList( @@ -185,7 +195,8 @@ srv_page_data_table <- function(id, variables_selected, dt_args, dt_options, - server_rendering) { + server_rendering, + decorators) { checkmate::assert_class(data, "reactive") checkmate::assert_class(isolate(data()), "teal_data") moduleServer(id, function(input, output, session) { @@ -238,7 +249,8 @@ srv_page_data_table <- function(id, ui_data_table( id = session$ns(x), choices = choices, - selected = variables_selected + selected = variables_selected, + decorators = decorators ) ) ) @@ -260,7 +272,8 @@ srv_page_data_table <- function(id, if_distinct = if_distinct, dt_args = dt_args, dt_options = dt_options, - server_rendering = server_rendering + server_rendering = server_rendering, + decorators = decorators ) } ) @@ -270,7 +283,8 @@ srv_page_data_table <- function(id, # UI function for the data_table module ui_data_table <- function(id, choices, - selected) { + selected, + decorators) { ns <- NS(id) if (!is.null(selected)) { @@ -282,6 +296,7 @@ ui_data_table <- function(id, tagList( teal.widgets::get_dt_rows(ns("data_table"), ns("dt_rows")), fluidRow( + ui_transform_teal_data(ns("decorate"), transformators = decorators), teal.widgets::optionalSelectInput( ns("variables"), "Select variables:", @@ -305,7 +320,8 @@ srv_data_table <- function(id, if_distinct, dt_args, dt_options, - server_rendering) { + server_rendering, + decorators) { moduleServer(id, function(input, output, session) { iv <- shinyvalidate::InputValidator$new() iv$add_rule("variables", shinyvalidate::sv_required("Please select valid variable names")) @@ -314,27 +330,48 @@ srv_data_table <- function(id, )) iv$enable() - output$data_table <- DT::renderDataTable(server = server_rendering, { - teal::validate_inputs(iv) - + data_table_data <- reactive({ df <- data()[[dataname]] - variables <- input$variables teal::validate_has_data(df, min_nrow = 1L, msg = paste("data", dataname, "is empty")) - dataframe_selected <- if (if_distinct()) { - dplyr::count(df, dplyr::across(dplyr::all_of(variables))) - } else { - df[variables] - } + teal.code::eval_code( + data(), + substitute( + expr = { + variables <- vars + dataframe_selected <- if (if_distinct) { + dplyr::count(dataname, dplyr::across(dplyr::all_of(variables))) + } else { + dataname[variables] + } + dt_args <- args + dt_args$options <- dt_options + if (!is.null(dt_rows)) { + dt_args$options$pageLength <- dt_rows + } + dt_args$data <- dataframe_selected + table <- do.call(DT::datatable, dt_args) + }, + env = list( + dataname = as.name(dataname), + if_distinct = if_distinct(), + vars = input$variables, + args = dt_args, + dt_options = dt_options, + dt_rows = input$dt_rows + ) + ) + ) + }) - dt_args$options <- dt_options - if (!is.null(input$dt_rows)) { - dt_args$options$pageLength <- input$dt_rows - } - dt_args$data <- dataframe_selected + decorated_data_table_data <- + srv_transform_teal_data("decorate", data = data_table_data, transformators = decorators) - do.call(DT::datatable, dt_args) + output$data_table <- DT::renderDataTable(server = server_rendering, { + req(data_table_data()) + teal::validate_inputs(iv) + decorated_data_table_data()[["table"]] }) }) } diff --git a/man/tm_data_table.Rd b/man/tm_data_table.Rd index 3d105c6c0..5661eb2ee 100644 --- a/man/tm_data_table.Rd +++ b/man/tm_data_table.Rd @@ -13,7 +13,8 @@ tm_data_table( scrollX = TRUE), server_rendering = FALSE, pre_output = NULL, - post_output = NULL + post_output = NULL, + decorators = NULL ) } \arguments{ @@ -46,6 +47,9 @@ with text placed before the output to put the output into context. For example a \item{post_output}{(\code{shiny.tag}) optional, text or UI element to be displayed after the module's output, adding context or further instructions. Elements like \code{shiny::helpText()} 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} or \code{NULL}) optional, +if not \code{NULL}, 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 @@ Configure the \code{DT.TOJSON_ARGS} option via \code{options(DT.TOJSON_ARGS = list(na = "string"))} before running the module. Note though that sorting of numeric columns with \code{NA}/\code{Inf} will be lexicographic not numerical. } +\section{Decorating \code{tm_data_table}}{ + + +This module generates the following objects, which can be modified in place using decorators: +\itemize{ +\item \code{table} (\code{\link[DT:datatable]{DT::datatable()}}) +} + +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{ # general data example data <- teal_data()