diff --git a/.github/workflows/check.yaml b/.github/workflows/check.yaml index 35c7bb7c53..9734e55bf7 100644 --- a/.github/workflows/check.yaml +++ b/.github/workflows/check.yaml @@ -51,6 +51,7 @@ jobs: insightsengineering/teal.reporter insightsengineering/teal.widgets insightsengineering/rtables + insightsengineering/formatters insightsengineering/rtables.officer r-cmd-non-cran: @@ -84,6 +85,7 @@ jobs: insightsengineering/teal.widgets insightsengineering/rtables insightsengineering/rtables.officer + insightsengineering/formatters coverage: name: Coverage 📔 @@ -103,6 +105,7 @@ jobs: insightsengineering/teal.widgets insightsengineering/rtables insightsengineering/rtables.officer + insightsengineering/formatters linter: if: github.event_name != 'push' name: SuperLinter 🦸‍♀️ @@ -124,6 +127,7 @@ jobs: insightsengineering/teal.widgets insightsengineering/rtables insightsengineering/rtables.officer + insightsengineering/formatters gitleaks: name: gitleaks 💧 uses: insightsengineering/r.pkg.template/.github/workflows/gitleaks.yaml@main diff --git a/.github/workflows/docs.yaml b/.github/workflows/docs.yaml index d4fae1f3f3..05754a3ce0 100644 --- a/.github/workflows/docs.yaml +++ b/.github/workflows/docs.yaml @@ -52,3 +52,4 @@ jobs: insightsengineering/teal.widgets insightsengineering/rtables insightsengineering/rtables.officer + insightsengineering/formatters diff --git a/.github/workflows/release.yaml b/.github/workflows/release.yaml index bddb1c4374..8bb1e979d8 100644 --- a/.github/workflows/release.yaml +++ b/.github/workflows/release.yaml @@ -26,6 +26,7 @@ jobs: insightsengineering/teal.widgets insightsengineering/rtables insightsengineering/rtables.officer + insightsengineering/formatters validation: name: R Package Validation report 📃 needs: release @@ -43,6 +44,7 @@ jobs: insightsengineering/teal.widgets insightsengineering/rtables insightsengineering/rtables.officer + insightsengineering/formatters release: name: Create release 🎉 uses: insightsengineering/r.pkg.template/.github/workflows/release.yaml@main @@ -77,6 +79,7 @@ jobs: insightsengineering/teal.widgets insightsengineering/rtables insightsengineering/rtables.officer + insightsengineering/formatters coverage: name: Coverage 📔 needs: [release, docs] @@ -96,6 +99,7 @@ jobs: insightsengineering/teal.widgets insightsengineering/rtables insightsengineering/rtables.officer + insightsengineering/formatters wasm: name: Build WASM packages 🧑‍🏭 needs: release diff --git a/.github/workflows/scheduled.yaml b/.github/workflows/scheduled.yaml index 4060f5cf99..63d21a4355 100644 --- a/.github/workflows/scheduled.yaml +++ b/.github/workflows/scheduled.yaml @@ -66,6 +66,7 @@ jobs: insightsengineering/teal.widgets insightsengineering/rtables insightsengineering/rtables.officer + insightsengineering/formatters rhub: if: > github.event_name == 'schedule' || ( @@ -84,3 +85,4 @@ jobs: insightsengineering/teal.widgets insightsengineering/rtables insightsengineering/rtables.officer + insightsengineering/formatters diff --git a/DESCRIPTION b/DESCRIPTION index 355157769e..f987ad0bb0 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -57,6 +57,7 @@ Imports: utils Suggests: bslib, + ggplot2 (>= 3.4.0), knitr (>= 1.42), mirai (>= 1.1.1), MultiAssayExperiment, @@ -122,6 +123,7 @@ Collate: 'teal_reporter.R' 'teal_slices-store.R' 'teal_slices.R' + 'teal_transform_module.R' 'utils.R' 'validate_inputs.R' 'validations.R' diff --git a/NAMESPACE b/NAMESPACE index e4c3a538d9..3e156a1e6f 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -22,6 +22,7 @@ export(get_code_tdata) export(get_metadata) export(init) export(landing_popup_module) +export(make_teal_transform_server) export(module) export(modules) export(new_tdata) @@ -31,12 +32,14 @@ export(set_datanames) export(show_rcode_modal) export(srv_teal) export(srv_teal_with_splash) +export(srv_transform_teal_data) export(tdata2env) export(teal_data_module) export(teal_slices) export(teal_transform_module) export(ui_teal) export(ui_teal_with_splash) +export(ui_transform_teal_data) export(validate_has_data) export(validate_has_elements) export(validate_has_variable) diff --git a/NEWS.md b/NEWS.md index fcd6688538..a71af2dfa1 100644 --- a/NEWS.md +++ b/NEWS.md @@ -3,7 +3,7 @@ ### New features * Possible to call `ui_teal` and `srv_teal` directly in any application by delivering `data` argument as a `reactive` returning `teal_data` object. #669 -* Introduced `teal_transform_module` to provide a way to interactively modify data delivered to `teal_module`'s `server`. #1228 +* Introduced `teal_transform_module` to provide a way to interactively modify data delivered to `teal_module`'s `server` and to decorate module outputs. #1228 #1384 * Introduced a new argument `once = FALSE` in `teal_data_module` to possibly reload data during a run time. * Possibility to download lockfile to restore app session for reproducibility. #479 * Introduced a function `set_datanames()` to change a `datanames` of the `teal_module`. diff --git a/R/dummy_functions.R b/R/dummy_functions.R index 201ca6df8d..b04c4a488b 100644 --- a/R/dummy_functions.R +++ b/R/dummy_functions.R @@ -2,7 +2,16 @@ #' #' `r lifecycle::badge("experimental")` #' +#' This module creates an object called `object` that can be modified with decorators. +#' The `object` is determined by what's selected in `Choose a dataset` input in UI. +#' The object can be anything that can be handled by `renderPrint()`. +#' See the `vignette("decorate-modules-output", package = "teal")` or [`teal_transform_module`] +#' to read more about decorators. +#' #' @inheritParams teal_modules +#' @param decorators `r lifecycle::badge("experimental")` (`list` of `teal_transform_module` or `NULL`) optional, +#' if not `NULL`, decorator for tables or plots included in the module. +#' #' @return A `teal` module which can be included in the `modules` argument to [init()]. #' @examples #' app <- init( @@ -13,11 +22,16 @@ #' shinyApp(app$ui, app$server) #' } #' @export -example_module <- function(label = "example teal module", datanames = "all", transformers = list()) { +example_module <- function(label = "example teal module", + datanames = "all", + transformators = list(), + decorators = NULL) { checkmate::assert_string(label) + checkmate::assert_list(decorators, "teal_transform_module", null.ok = TRUE) + ans <- module( label, - server = function(id, data) { + server = function(id, data, decorators) { checkmate::assert_class(isolate(data()), "teal_data") moduleServer(id, function(input, output, session) { datanames_rv <- reactive(names(req(data()))) @@ -36,30 +50,52 @@ example_module <- function(label = "example teal module", datanames = "all", tra ) }) - output$text <- renderPrint({ + table_data <- reactive({ req(input$dataname) - data()[[input$dataname]] + within(data(), + { + object <- dataname + }, + dataname = as.name(input$dataname) + ) + }) + + table_data_decorated_no_print <- srv_transform_teal_data( + "decorate", + data = table_data, + transformators = decorators + ) + table_data_decorated <- reactive(within(req(table_data_decorated_no_print()), expr = object)) + + output$text <- renderPrint({ + req(table_data()) # Ensure original errors from module are displayed + table_data_decorated()[["object"]] }) teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(data())), + verbatim_content = reactive(teal.code::get_code(req(table_data_decorated()))), title = "Example Code" ) + + table_data_decorated }) }, - ui = function(id) { + ui = function(id, decorators) { ns <- NS(id) teal.widgets::standard_layout( output = verbatimTextOutput(ns("text")), encoding = tags$div( selectInput(ns("dataname"), "Choose a dataset", choices = NULL), + ui_transform_teal_data(ns("decorate"), transformators = decorators), teal.widgets::verbatim_popup_ui(ns("rcode"), "Show R code") ) ) }, + ui_args = list(decorators = decorators), + server_args = list(decorators = decorators), datanames = datanames, - transformers = transformers + transformators = transformators ) attr(ans, "teal_bookmarkable") <- TRUE ans diff --git a/R/init.R b/R/init.R index 72a61380d4..3f27eb385e 100644 --- a/R/init.R +++ b/R/init.R @@ -202,7 +202,7 @@ init <- function(data, } is_modules_ok <- check_modules_datanames(modules, names(data)) - if (!isTRUE(is_modules_ok) && length(unlist(extract_transformers(modules))) == 0) { + if (!isTRUE(is_modules_ok) && length(unlist(extract_transformators(modules))) == 0) { warning(is_modules_ok, call. = FALSE) } diff --git a/R/module_data_summary.R b/R/module_data_summary.R index 72e8a1850c..0d2bc7b526 100644 --- a/R/module_data_summary.R +++ b/R/module_data_summary.R @@ -148,10 +148,10 @@ get_filter_overview_wrapper <- function(teal_data) { current_data_objs <- sapply( datanames, - function(name) teal.code::get_var(teal_data(), name), + function(name) teal_data()[[name]], simplify = FALSE ) - initial_data_objs <- teal.code::get_var(teal_data(), ".raw_data") + initial_data_objs <- teal_data()[[".raw_data"]] out <- lapply( datanames, diff --git a/R/module_nested_tabs.R b/R/module_nested_tabs.R index 748ca63785..e26533cc92 100644 --- a/R/module_nested_tabs.R +++ b/R/module_nested_tabs.R @@ -92,22 +92,22 @@ ui_teal_module.teal_module <- function(id, modules, depth = 0L) { args <- c(list(id = ns("module")), modules$ui_args) ui_teal <- tagList( - div( - id = ns("validate_datanames"), - ui_validate_reactive_teal_data(ns("validate_datanames")) - ), shinyjs::hidden( tags$div( - id = ns("transformer_failure_info"), + id = ns("transform_failure_info"), class = "teal_validated", div( class = "teal-output-warning", - "One of transformers failed. Please fix and continue." + "One of transformators failed. Please check its inputs." ) ) ), tags$div( id = ns("teal_module_ui"), + tags$div( + class = "teal_validated", + ui_check_module_datanames(ns("validate_datanames")) + ), do.call(modules$ui, args) ) ) @@ -125,18 +125,12 @@ ui_teal_module.teal_module <- function(id, modules, depth = 0L) { width = 3, ui_data_summary(ns("data_summary")), ui_filter_data(ns("filter_panel")), - ui_transform_data(ns("data_transform"), transformers = modules$transformers, class = "well"), + ui_transform_teal_data(ns("data_transform"), transformators = modules$transformators, class = "well"), class = "teal_secondary_col" ) ) } else { - div( - div( - class = "teal_validated", - uiOutput(ns("data_input_error")) - ), - ui_teal - ) + ui_teal } ) ) @@ -266,27 +260,25 @@ srv_teal_module.teal_module <- function(id, data_rv = data_rv, is_active = is_active ) - is_transformer_failed <- reactiveValues() - transformed_teal_data <- srv_transform_data( + is_transform_failed <- reactiveValues() + transformed_teal_data <- srv_transform_teal_data( "data_transform", data = filtered_teal_data, - transformers = modules$transformers, + transformators = modules$transformators, modules = modules, - is_transformer_failed = is_transformer_failed + is_transform_failed = is_transform_failed ) - any_transformer_failed <- reactive({ - any(unlist(reactiveValuesToList(is_transformer_failed))) + any_transform_failed <- reactive({ + any(unlist(reactiveValuesToList(is_transform_failed))) }) - observeEvent(any_transformer_failed(), { - if (isTRUE(any_transformer_failed())) { + observeEvent(any_transform_failed(), { + if (isTRUE(any_transform_failed())) { shinyjs::hide("teal_module_ui") - shinyjs::hide("validate_datanames") - shinyjs::show("transformer_failure_info") + shinyjs::show("transform_failure_info") } else { shinyjs::show("teal_module_ui") - shinyjs::show("validate_datanames") - shinyjs::hide("transformer_failure_info") + shinyjs::hide("transform_failure_info") } }) @@ -297,7 +289,7 @@ srv_teal_module.teal_module <- function(id, all_teal_data[c(module_datanames, ".raw_data")] }) - srv_validate_reactive_teal_data( + srv_check_module_datanames( "validate_datanames", data = module_teal_data, modules = modules diff --git a/R/module_teal.R b/R/module_teal.R index 091d1b57d4..66cddbfce8 100644 --- a/R/module_teal.R +++ b/R/module_teal.R @@ -187,12 +187,20 @@ srv_teal <- function(id, data, modules, filter = teal_slices()) { ) data_pulled <- srv_init_data("data", data = data) - data_validated <- srv_validate_reactive_teal_data( - "validate", - data = data_pulled, - modules = modules, - validate_shiny_silent_error = FALSE + + validate_ui <- tags$div( + id = session$ns("validate_messages"), + class = "teal_validated", + ui_check_class_teal_data(session$ns("class_teal_data")), + ui_validate_error(session$ns("silent_error")), + ui_check_module_datanames(session$ns("datanames_warning")) ) + srv_check_class_teal_data("class_teal_data", data_pulled) + srv_validate_error("silent_error", data_pulled, validate_shiny_silent_error = FALSE) + srv_check_module_datanames("datanames_warning", data_pulled, modules) + + data_validated <- .trigger_on_success(data_pulled) + data_rv <- reactive({ req(inherits(data_validated(), "teal_data")) is_filter_ok <- check_filter_datanames(filter, names(data_validated())) @@ -225,6 +233,8 @@ srv_teal <- function(id, data, modules, filter = teal_slices()) { }) } + + if (inherits(data, "teal_data_module")) { setBookmarkExclude(c("teal_modules-active_tab")) shiny::insertTab( @@ -236,7 +246,7 @@ srv_teal <- function(id, data, modules, filter = teal_slices()) { value = "teal_data_module", tags$div( ui_init_data(session$ns("data")), - ui_validate_reactive_teal_data(session$ns("validate")) + validate_ui ) ) ) @@ -253,7 +263,7 @@ srv_teal <- function(id, data, modules, filter = teal_slices()) { insertUI( selector = sprintf("#%s", session$ns("tabpanel_wrapper")), where = "beforeBegin", - ui = tags$div(ui_validate_reactive_teal_data(session$ns("validate")), tags$br()) + ui = tags$div(validate_ui, tags$br()) ) } diff --git a/R/module_teal_data.R b/R/module_teal_data.R index fbb8a64e9a..056c2ffdcc 100644 --- a/R/module_teal_data.R +++ b/R/module_teal_data.R @@ -25,8 +25,8 @@ #' @param data_module (`teal_data_module`) #' @param modules (`teal_modules` or `teal_module`) For `datanames` validation purpose #' @param validate_shiny_silent_error (`logical`) If `TRUE`, then `shiny.silent.error` is validated and -#' @param is_transformer_failed (`reactiveValues`) contains `logical` flags named after each transformer. -#' Help to determine if any previous transformer failed, so that following transformers can be disabled +#' @param is_transform_failed (`reactiveValues`) contains `logical` flags named after each transformator. +#' Help to determine if any previous transformator failed, so that following transformators can be disabled #' and display a generic failure message. #' #' @return `reactive` `teal_data` @@ -53,29 +53,29 @@ srv_teal_data <- function(id, data_module = function(id) NULL, modules = NULL, validate_shiny_silent_error = TRUE, - is_transformer_failed = reactiveValues()) { + is_transform_failed = reactiveValues()) { checkmate::assert_string(id) checkmate::assert_function(data_module, args = "id") checkmate::assert_multi_class(modules, c("teal_modules", "teal_module"), null.ok = TRUE) - checkmate::assert_class(is_transformer_failed, "reactivevalues") + checkmate::assert_class(is_transform_failed, "reactivevalues") moduleServer(id, function(input, output, session) { logger::log_debug("srv_teal_data initializing.") - is_transformer_failed[[id]] <- FALSE + is_transform_failed[[id]] <- FALSE data_out <- data_module(id = "data") data_handled <- reactive(tryCatch(data_out(), error = function(e) e)) observeEvent(data_handled(), { if (!inherits(data_handled(), "teal_data")) { - is_transformer_failed[[id]] <- TRUE + is_transform_failed[[id]] <- TRUE } else { - is_transformer_failed[[id]] <- FALSE + is_transform_failed[[id]] <- FALSE } }) is_previous_failed <- reactive({ - idx_this <- which(names(is_transformer_failed) == id) - is_transformer_failed_list <- reactiveValuesToList(is_transformer_failed) - idx_failures <- which(unlist(is_transformer_failed_list)) + idx_this <- which(names(is_transform_failed) == id) + is_transform_failed_list <- reactiveValuesToList(is_transform_failed) + idx_failures <- which(unlist(is_transform_failed_list)) any(idx_failures < idx_this) }) @@ -106,7 +106,7 @@ ui_validate_reactive_teal_data <- function(id) { class = "teal_validated", ui_validate_error(ns("silent_error")), ui_check_class_teal_data(ns("class_teal_data")), - ui_check_shiny_warnings(ns("shiny_warnings")) + ui_check_module_datanames(ns("shiny_warnings")) ), div( class = "teal_validated", @@ -129,11 +129,11 @@ srv_validate_reactive_teal_data <- function(id, # nolint: object_length # there is an empty reactive cycle on `init` and `data_rv` has `shiny.silent.error` class srv_validate_error("silent_error", data, validate_shiny_silent_error) srv_check_class_teal_data("class_teal_data", data) - srv_check_shiny_warnings("shiny_warnings", data, modules) + srv_check_module_datanames("shiny_warnings", data, modules) output$previous_failed <- renderUI({ if (hide_validation_error()) { shinyjs::hide("validate_messages") - tags$div("One of previous transformers failed. Please fix and continue.", class = "teal-output-warning") + tags$div("One of previous transformators failed. Please check its inputs.", class = "teal-output-warning") } else { shinyjs::show("validate_messages") NULL @@ -211,13 +211,13 @@ srv_check_class_teal_data <- function(id, data) { } #' @keywords internal -ui_check_shiny_warnings <- function(id) { +ui_check_module_datanames <- function(id) { ns <- NS(id) uiOutput(NS(id, "message")) } #' @keywords internal -srv_check_shiny_warnings <- function(id, data, modules) { +srv_check_module_datanames <- function(id, data, modules) { checkmate::assert_string(id) moduleServer(id, function(input, output, session) { output$message <- renderUI({ diff --git a/R/module_transform_data.R b/R/module_transform_data.R index f47a13d051..8acaa95388 100644 --- a/R/module_transform_data.R +++ b/R/module_transform_data.R @@ -1,79 +1,149 @@ #' Module to transform `reactive` `teal_data` #' -#' Module calls multiple [`module_teal_data`] in sequence so that `reactive teal_data` output +#' Module calls [teal_transform_module()] in sequence so that `reactive teal_data` output #' from one module is handed over to the following module's input. #' #' @inheritParams module_teal_data #' @inheritParams teal_modules +#' @param class (character(1)) CSS class to be added in the `div` wrapper tag. + #' @return `reactive` `teal_data` #' -#' #' @name module_transform_data -#' @keywords internal NULL +#' @export #' @rdname module_transform_data -ui_transform_data <- function(id, transformers = list(), class = "well") { +ui_transform_teal_data <- function(id, transformators, class = "well") { checkmate::assert_string(id) - checkmate::assert_list(transformers, "teal_transform_module") - - ns <- NS(id) - labels <- lapply(transformers, function(x) attr(x, "label")) - ids <- get_unique_labels(labels) - names(transformers) <- ids + if (length(transformators) == 0L) { + return(NULL) + } + if (inherits(transformators, "teal_transform_module")) { + transformators <- list(transformators) + } + checkmate::assert_list(transformators, "teal_transform_module") + names(transformators) <- sprintf("transform_%d", seq_len(length(transformators))) lapply( - names(transformers), + names(transformators), function(name) { - data_mod <- transformers[[name]] - wrapper_id <- ns(sprintf("wrapper_%s", name)) - div( - # class .teal_validated changes the color of the boarder on error in ui_validate_reactive_teal_data - # For details see tealValidate.js file. - class = c(class, "teal_validated"), - title = attr(data_mod, "label"), - tags$span( - class = "text-primary mb-4", - icon("fas fa-square-pen"), - attr(data_mod, "label") - ), - tags$i( - class = "remove pull-right fa fa-angle-down", - style = "cursor: pointer;", - title = "fold/expand transform panel", - onclick = sprintf("togglePanelItems(this, '%s', 'fa-angle-right', 'fa-angle-down');", wrapper_id) - ), + child_id <- NS(id, name) + ns <- NS(child_id) + data_mod <- transformators[[name]] + transform_wrapper_id <- ns(sprintf("wrapper_%s", name)) + + display_fun <- if (is.null(data_mod$ui)) shinyjs::hidden else function(x) x + + display_fun( div( - id = wrapper_id, - ui_teal_data(id = ns(name), data_module = transformers[[name]]$ui) + # class .teal_validated changes the color of the boarder on error in ui_validate_reactive_teal_data + # For details see tealValidate.js file. + id = ns("wrapper"), + class = c(class, "teal_validated"), + title = attr(data_mod, "label"), + tags$span( + class = "text-primary mb-4", + icon("fas fa-square-pen"), + attr(data_mod, "label") + ), + tags$i( + class = "remove pull-right fa fa-angle-down", + style = "cursor: pointer;", + title = "fold/expand transformator panel", + onclick = sprintf("togglePanelItems(this, '%s', 'fa-angle-right', 'fa-angle-down');", transform_wrapper_id) + ), + tags$div( + id = transform_wrapper_id, + if (is.null(data_mod$ui)) { + return(NULL) + } else { + data_mod$ui(id = ns("transform")) + }, + div( + id = ns("validate_messages"), + class = "teal_validated", + uiOutput(ns("error_wrapper")) + ) + ) ) ) } ) } +#' @export #' @rdname module_transform_data -srv_transform_data <- function(id, data, transformers = list(), modules, is_transformer_failed = reactiveValues()) { +srv_transform_teal_data <- function(id, data, transformators, modules = NULL, is_transform_failed = reactiveValues()) { checkmate::assert_string(id) assert_reactive(data) - checkmate::assert_list(transformers, "teal_transform_module") - checkmate::assert_class(modules, "teal_module") - labels <- lapply(transformers, function(x) attr(x, "label")) - ids <- get_unique_labels(labels) - names(transformers) <- ids + checkmate::assert_class(modules, "teal_module", null.ok = TRUE) + if (length(transformators) == 0L) { + return(data) + } + if (inherits(transformators, "teal_transform_module")) { + transformators <- list(transformators) + } + checkmate::assert_list(transformators, "teal_transform_module", null.ok = TRUE) + names(transformators) <- sprintf("transform_%d", seq_len(length(transformators))) + moduleServer(id, function(input, output, session) { - logger::log_debug("srv_teal_data_modules initializing.") - Reduce( - function(previous_result, name) { - srv_teal_data( - id = name, - data_module = function(id) transformers[[name]]$server(id, previous_result), - modules = modules, - is_transformer_failed = is_transformer_failed - ) + module_output <- Reduce( + function(data_previous, name) { + moduleServer(name, function(input, output, session) { + logger::log_debug("srv_transform_teal_data initializing for { name }.") + is_transform_failed[[name]] <- FALSE + data_out <- transformators[[name]]$server("transform", data = data_previous) + data_handled <- reactive(tryCatch(data_out(), error = function(e) e)) + observeEvent(data_handled(), { + if (inherits(data_handled(), "teal_data")) { + is_transform_failed[[name]] <- FALSE + } else { + is_transform_failed[[name]] <- TRUE + } + }) + + is_previous_failed <- reactive({ + idx_this <- which(names(is_transform_failed) == name) + is_transform_failed_list <- reactiveValuesToList(is_transform_failed) + idx_failures <- which(unlist(is_transform_failed_list)) + any(idx_failures < idx_this) + }) + + srv_validate_error("silent_error", data_handled, validate_shiny_silent_error = FALSE) + srv_check_class_teal_data("class_teal_data", data_handled) + if (!is.null(modules)) { + srv_check_module_datanames("datanames_warning", data_handled, modules) + } + + # When there is no UI (`ui = NULL`) it should still show the errors + observe({ + if (!inherits(data_handled(), "teal_data") && !is_previous_failed()) { + shinyjs::show("wrapper") + } + }) + + transform_wrapper_id <- sprintf("wrapper_%s", name) + output$error_wrapper <- renderUI({ + if (is_previous_failed()) { + shinyjs::disable(transform_wrapper_id) + tags$div("One of previous transformators failed. Please check its inputs.", class = "teal-output-warning") + } else { + shinyjs::enable(transform_wrapper_id) + shiny::tagList( + ui_validate_error(session$ns("silent_error")), + ui_check_class_teal_data(session$ns("class_teal_data")), + ui_check_module_datanames(session$ns("datanames_warning")) + ) + } + }) + + .trigger_on_success(data_handled) + }) }, - x = names(transformers), + x = names(transformators), init = data ) + module_output }) } diff --git a/R/modules.R b/R/modules.R index f6d5bfcbe1..2b27d5bb41 100644 --- a/R/modules.R +++ b/R/modules.R @@ -35,12 +35,12 @@ setOldClass("teal_modules") #' in a warning. Datasets with names starting with . are ignored globally unless explicitly listed #' in `datanames`. #' -#' # `datanames` with `transformers` -#' When transformers are specified, their `datanames` are added to the module’s `datanames`, which +#' # `datanames` with `transformators` +#' When transformators are specified, their `datanames` are added to the module’s `datanames`, which #' changes the behavior as follows: -#' - If `module(datanames)` is `NULL` and the `transformers` have defined `datanames`, the sidebar -#' will appear showing the `transformers`' datasets, instead of being hidden. -#' - If `module(datanames)` is set to specific values and any `transformer` has `datanames = "all"`, +#' - If `module(datanames)` is `NULL` and the `transformators` have defined `datanames`, the sidebar +#' will appear showing the `transformators`' datasets, instead of being hidden. +#' - If `module(datanames)` is set to specific values and any `transformator` has `datanames = "all"`, #' the module may receive extra datasets that could be unnecessary #' #' @param label (`character(1)`) Label shown in the navigation item for the module or module group. @@ -69,15 +69,13 @@ setOldClass("teal_modules") #' There are 2 reserved values that have specific behaviors: #' - The keyword `"all"` includes all datasets available in the data passed to the teal application. #' - `NULL` hides the sidebar panel completely. -#' - If `transformers` are specified, their `datanames` are automatically added to this `datanames` +#' - If `transformators` are specified, their `datanames` are automatically added to this `datanames` #' argument. #' @param server_args (named `list`) with additional arguments passed on to the server function. #' @param ui_args (named `list`) with additional arguments passed on to the UI function. #' @param x (`teal_module` or `teal_modules`) Object to format/print. -#' @param indent (`integer(1)`) Indention level; each nested element is indented one level more. -#' @param transformers (`list` of `teal_data_module`) that will be applied to transform the data. -#' Each transform module UI will appear in the `teal`'s sidebar panel. -#' Transformers' `datanames` are added to the `datanames`. See [teal_transform_module()]. +#' @param transformators (`list` of `teal_transform_module`) that will be applied to transformator module's data input. +#' #' #' @param ... #' - For `modules()`: (`teal_module` or `teal_modules`) Objects to wrap into a tab. @@ -158,7 +156,7 @@ module <- function(label = "module", datanames = "all", server_args = NULL, ui_args = NULL, - transformers = list()) { + transformators = list()) { # argument checking (independent) ## `label` checkmate::assert_string(label) @@ -265,16 +263,16 @@ module <- function(label = "module", ) } - ## `transformers` - if (inherits(transformers, "teal_transform_module")) { - transformers <- list(transformers) + ## `transformators` + if (inherits(transformators, "teal_transform_module")) { + transformators <- list(transformators) } - checkmate::assert_list(transformers, types = "teal_transform_module") - transformer_datanames <- unlist(lapply(transformers, attr, "datanames")) + checkmate::assert_list(transformators, types = "teal_transform_module") + transform_datanames <- unlist(lapply(transformators, attr, "datanames")) combined_datanames <- if (identical(datanames, "all")) { "all" } else { - union(datanames, transformer_datanames) + union(datanames, transform_datanames) } structure( @@ -285,7 +283,7 @@ module <- function(label = "module", datanames = combined_datanames, server_args = server_args, ui_args = ui_args, - transformers = transformers + transformators = transformators ), class = "teal_module" ) @@ -328,22 +326,22 @@ modules <- function(..., label = "root") { #' @param is_root (`logical(1)`) Whether this is the root node of the tree. Only used in #' format.teal_modules(). Determines whether to show "TEAL ROOT" header #' @param what (`character`) Specifies which metadata to display. -#' Possible values: "datasets", "properties", "ui_args", "server_args", "transformers" +#' Possible values: "datasets", "properties", "ui_args", "server_args", "transformators" #' @examples #' mod <- module( #' label = "My Custom Module", #' server = function(id, data, ...) {}, #' ui = function(id, ...) {}, #' datanames = c("ADSL", "ADTTE"), -#' transformers = list(), +#' transformators = list(), #' ui_args = list(a = 1, b = "b"), #' server_args = list(x = 5, y = list(p = 1)) #' ) #' cat(format(mod)) #' @export format.teal_module <- function( - x, indent = 0, is_last = FALSE, parent_prefix = "", - what = c("datasets", "properties", "ui_args", "server_args", "transformers"), ...) { + x, is_last = FALSE, parent_prefix = "", + what = c("datasets", "properties", "ui_args", "server_args", "transformators"), ...) { empty_text <- "" branch <- if (is_last) "L-" else "|-" current_prefix <- paste0(parent_prefix, branch, " ") @@ -380,8 +378,8 @@ format.teal_module <- function( bookmarkable <- isTRUE(attr(x, "teal_bookmarkable")) reportable <- "reporter" %in% names(formals(x$server)) - transformers <- if (length(x$transformers) > 0) { - paste(sapply(x$transformers, function(t) attr(t, "label")), collapse = ", ") + transformators <- if (length(x$transformators) > 0) { + paste(sapply(x$transformators, function(t) attr(t, "label")), collapse = ", ") } else { empty_text } @@ -416,10 +414,10 @@ format.teal_module <- function( content_prefix, "|- ", crayon::green("Server Arguments : "), server_args_formatted, "\n" ) } - if ("transformers" %in% what) { + if ("transformators" %in% what) { output <- paste0( output, - content_prefix, "L- ", crayon::magenta("Transformers : "), transformers, "\n" + content_prefix, "L- ", crayon::magenta("Transformators : "), transformators, "\n" ) } @@ -430,14 +428,14 @@ format.teal_module <- function( #' @examples #' custom_module <- function( #' label = "label", ui_args = NULL, server_args = NULL, -#' datanames = "all", transformers = list(), bk = FALSE) { +#' datanames = "all", transformators = list(), bk = FALSE) { #' ans <- module( #' label, #' server = function(id, data, ...) {}, #' ui = function(id, ...) { #' }, #' datanames = datanames, -#' transformers = transformers, +#' transformators = transformators, #' ui_args = ui_args, #' server_args = server_args #' ) @@ -445,7 +443,7 @@ format.teal_module <- function( #' ans #' } #' -#' dummy_transformer <- teal_transform_module( +#' dummy_transformator <- teal_transform_module( #' label = "Dummy Transform", #' ui = function(id) div("(does nothing)"), #' server = function(id, data) { @@ -453,7 +451,7 @@ format.teal_module <- function( #' } #' ) #' -#' plot_transformer <- teal_transform_module( +#' plot_transformator <- teal_transform_module( #' label = "Plot Settings", #' ui = function(id) div("(does nothing)"), #' server = function(id, data) { @@ -474,7 +472,7 @@ format.teal_module <- function( #' cache = TRUE, #' debounce = 1000 #' ), -#' transformers = list(dummy_transformer), +#' transformators = list(dummy_transformator), #' bk = TRUE #' ), #' modules( @@ -492,7 +490,7 @@ format.teal_module <- function( #' render_type = "svg", #' cache_plots = TRUE #' ), -#' transformers = list(dummy_transformer, plot_transformer), +#' transformators = list(dummy_transformator, plot_transformator), #' bk = TRUE #' ), #' modules( @@ -524,9 +522,9 @@ format.teal_module <- function( #' ) #' #' cat(format(complete_modules)) -#' cat(format(complete_modules, what = c("ui_args", "server_args", "transformers"))) +#' cat(format(complete_modules, what = c("ui_args", "server_args", "transformators"))) #' @export -format.teal_modules <- function(x, indent = 0, is_root = TRUE, is_last = FALSE, parent_prefix = "", ...) { +format.teal_modules <- function(x, is_root = TRUE, is_last = FALSE, parent_prefix = "", ...) { if (is_root) { header <- pasten(crayon::bold("TEAL ROOT")) new_parent_prefix <- " " #' Initial indent for root level @@ -553,7 +551,6 @@ format.teal_modules <- function(x, indent = 0, is_root = TRUE, is_last = FALSE, children_output <- c( children_output, format(child, - indent = indent, is_root = FALSE, is_last = is_last_child, parent_prefix = new_parent_prefix, @@ -564,7 +561,6 @@ format.teal_modules <- function(x, indent = 0, is_root = TRUE, is_last = FALSE, children_output <- c( children_output, format(child, - indent = indent, is_last = is_last_child, parent_prefix = new_parent_prefix, ... diff --git a/R/teal_data_module-within.R b/R/teal_data_module-within.R index e4c56b4fcc..034a2db52c 100644 --- a/R/teal_data_module-within.R +++ b/R/teal_data_module-within.R @@ -6,7 +6,7 @@ #' the `...` argument: as `name:value` pairs are passed to `...`, `name` in `expr` will be replaced with `value.` #' #' @param data (`teal_data_module`) object -#' @param expr (`expression`) to evaluate. Must be inline code. See +#' @param expr (`expression`) to evaluate. Must be inline code. See [within()] #' @param ... See `Details`. #' #' @return diff --git a/R/teal_data_module.R b/R/teal_data_module.R index ae1c815857..64ed9d9cba 100644 --- a/R/teal_data_module.R +++ b/R/teal_data_module.R @@ -81,118 +81,3 @@ teal_data_module <- function(ui, server, label = "data module", once = TRUE) { once = once ) } - -#' Data module for `teal` transformers. -#' -#' @description -#' `r lifecycle::badge("experimental")` -#' -#' Create a `teal_data_module` object for custom transformation of data for pre-processing -#' before passing the data into the module. -#' -#' @details -#' `teal_transform_module` creates a [`teal_data_module`] object to transform data in a `teal` -#' application. This transformation happens after the data has passed through the filtering activity -#' in teal. The transformed data is then sent to the server of the [teal_module()]. -#' -#' See vignette `vignette("data-transform-as-shiny-module", package = "teal")` for more details. -#' -#' -#' @inheritParams teal_data_module -#' @param server (`function(id, data)`) -#' `shiny` module server function; that takes `id` and `data` argument, -#' where the `id` is the module id and `data` is the reactive `teal_data` input. -#' The server function must return reactive expression containing `teal_data` object. -#' -#' The server function definition should not use `eventReactive` as it may lead to -#' unexpected behavior. -#' See `vignettes("data-transform-as-shiny-module")` for more information. -#' @param datanames (`character`) -#' Names of the datasets that are relevant for this module to evaluate. If set to `character(0)` -#' then module would receive [modules()] `datanames`. -#' @examples -#' my_transformers <- list( -#' teal_transform_module( -#' label = "Custom transform for iris", -#' datanames = "iris", -#' ui = function(id) { -#' ns <- NS(id) -#' tags$div( -#' numericInput(ns("n_rows"), "Subset n rows", value = 6, min = 1, max = 150, step = 1) -#' ) -#' }, -#' server = function(id, data) { -#' moduleServer(id, function(input, output, session) { -#' reactive({ -#' within(data(), -#' { -#' iris <- head(iris, num_rows) -#' }, -#' num_rows = input$n_rows -#' ) -#' }) -#' }) -#' } -#' ) -#' ) -#' -#' @name teal_transform_module -#' -#' @export -teal_transform_module <- function(ui = function(id) NULL, - server = function(id, data) data, - label = "transform module", - datanames = character(0)) { - checkmate::assert_function(ui, args = "id", nargs = 1) - checkmate::assert_function(server, args = c("id", "data"), nargs = 2) - checkmate::assert_string(label) - checkmate::assert_character(datanames) - if (identical(datanames, "all")) { - stop( - "teal_transform_module can't have datanames property equal to 'all'. Set `datanames = character(0)` instead.", - call. = FALSE - ) - } - structure( - list( - ui = ui, - server = function(id, data) { - data_out <- server(id, data) - - if (inherits(data_out, "reactive.event")) { - # This warning message partially detects when `eventReactive` is used in `data_module`. - warning( - "teal_transform_module() ", - "Using eventReactive in teal_transform module server code should be avoided as it ", - "may lead to unexpected behavior. See the vignettes for more information ", - "(`vignette(\"data-transform-as-shiny-module\", package = \"teal\")`).", - call. = FALSE - ) - } - - decorate_err_msg( - assert_reactive(data_out), - pre = sprintf("From: 'teal_transform_module()':\nA 'teal_transform_module' with \"%s\" label:", label), - post = "Please make sure that this module returns a 'reactive` object containing 'teal_data' class of object." # nolint: line_length_linter. - ) - } - ), - label = label, - datanames = datanames, - class = c("teal_transform_module", "teal_data_module") - ) -} - - -#' Extract all `transformers` from `modules`. -#' -#' @param modules `teal_modules` or `teal_module` -#' @return A list of `teal_transform_module` nested in the same way as input `modules`. -#' @keywords internal -extract_transformers <- function(modules) { - if (inherits(modules, "teal_module")) { - modules$transformers - } else if (inherits(modules, "teal_modules")) { - lapply(modules$children, extract_transformers) - } -} diff --git a/R/teal_transform_module.R b/R/teal_transform_module.R new file mode 100644 index 0000000000..b4a6a9deda --- /dev/null +++ b/R/teal_transform_module.R @@ -0,0 +1,226 @@ +#' Data module for `teal` transformations and output customization +#' +#' @description +#' `r lifecycle::badge("experimental")` +#' +#' `teal_transform_module` provides a `shiny` module that enables data transformations within a `teal` application +#' and allows for customization of outputs generated by modules. +#' +#' # Transforming Module Inputs in `teal` +#' +#' Data transformations occur after data has been filtered in `teal`. +#' The transformed data is then passed to the `server` of [`teal_module()`] and managed by `teal`'s internal processes. +#' The primary advantage of `teal_transform_module` over custom modules is in its error handling, where all warnings and +#' errors are managed by `teal`, allowing developers to focus on transformation logic. +#' +#' For more details, see the vignette: `vignette("data-transform-as-shiny-module", package = "teal")`. +#' +#' # Customizing Module Outputs +#' +#' `teal_transform_module` also allows developers to modify any object created within [`teal.data::teal_data`]. +#' This means you can use it to customize not only datasets but also tables, listings, and graphs. +#' Some [`teal_modules`] permit developers to inject custom `shiny` modules to enhance displayed outputs. +#' To manage these `decorators` within your module, use [`ui_transform_teal_data()`] and [`srv_transform_teal_data()`]. +#' (For further guidance on managing decorators, refer to `ui_args` and `srv_args` in the vignette documentation.) +#' +#' See the vignette `vignette("decorate-modules-output", package = "teal")` for additional examples. +#' +#' # `server` as a language +#' +#' The `server` function in `teal_transform_module` must return a reactive [`teal.data::teal_data`] object. +#' For simple transformations without complex reactivity, the `server` function might look like this:s +#' +#' ``` +#' function(id, data) { +#' moduleServer(id, function(input, output, session) { +#' reactive({ +#' within( +#' data(), +#' expr = x <- subset(x, col == level), +#' level = input$level +#' ) +#' }) +#' }) +#' } +#' ``` +#' +#' The example above can be simplified using `make_teal_transform_server`, where `level` is automatically matched to the +#' corresponding `input` parameter: +#' +#' ``` +#' make_teal_transform_server(expr = expression(x <- subset(x, col == level))) +#' ``` +#' @inheritParams teal_data_module +#' @param server (`function(id, data)` or `expression`) +#' A `shiny` module server function that takes `id` and `data` as arguments, where `id` is the module id and `data` +#' is the reactive `teal_data` input. The `server` function must return a reactive expression containing a `teal_data` +#' object. For simplified syntax, use [`make_teal_transform_server()`]. +#' @param datanames (`character`) +#' Specifies the names of datasets relevant to the module. Only filters for the specified `datanames` will be displayed +#' in the filter panel. The keyword `"all"` can be used to display filters for all datasets. `datanames` are +#' automatically appended to the [`modules()`] `datanames`. +#' +#' +#' @examples +#' data_transformators <- list( +#' teal_transform_module( +#' label = "Static transformator for iris", +#' datanames = "iris", +#' server = function(id, data) { +#' moduleServer(id, function(input, output, session) { +#' reactive({ +#' within(data(), { +#' iris <- head(iris, 5) +#' }) +#' }) +#' }) +#' } +#' ), +#' teal_transform_module( +#' label = "Interactive transformator for iris", +#' datanames = "iris", +#' ui = function(id) { +#' ns <- NS(id) +#' tags$div( +#' numericInput(ns("n_cols"), "Show n columns", value = 5, min = 1, max = 5, step = 1) +#' ) +#' }, +#' server = function(id, data) { +#' moduleServer(id, function(input, output, session) { +#' reactive({ +#' within(data(), +#' { +#' iris <- iris[, 1:n_cols] +#' }, +#' n_cols = input$n_cols +#' ) +#' }) +#' }) +#' } +#' ) +#' ) +#' +#' output_decorator <- teal_transform_module( +#' server = make_teal_transform_server( +#' expression( +#' object <- rev(object) +#' ) +#' ) +#' ) +#' +#' app <- init( +#' data = teal_data(iris = iris), +#' modules = example_module( +#' transformators = data_transformators, +#' decorators = list(output_decorator) +#' ) +#' ) +#' if (interactive()) { +#' shinyApp(app$ui, app$server) +#' } +#' +#' @name teal_transform_module +#' +#' @export +teal_transform_module <- function(ui = NULL, + server = function(id, data) data, + label = "transform module", + datanames = "all") { + structure( + list( + ui = ui, + server = function(id, data) { + data_out <- server(id, data) + + if (inherits(data_out, "reactive.event")) { + # This warning message partially detects when `eventReactive` is used in `data_module`. + warning( + "teal_transform_module() ", + "Using eventReactive in teal_transform module server code should be avoided as it ", + "may lead to unexpected behavior. See the vignettes for more information ", + "(`vignette(\"data-transform-as-shiny-module\", package = \"teal\")`).", + call. = FALSE + ) + } + + + decorate_err_msg( + assert_reactive(data_out), + pre = sprintf("From: 'teal_transform_module()':\nA 'teal_transform_module' with \"%s\" label:", label), + post = "Please make sure that this module returns a 'reactive` object containing 'teal_data' class of object." # nolint: line_length_linter. + ) + } + ), + label = label, + datanames = datanames, + class = c("teal_transform_module", "teal_data_module") + ) +} + +#' Make teal_transform_module's server +#' +#' A factory function to simplify creation of a [`teal_transform_module`]'s server. Specified `expr` +#' is wrapped in a shiny module function and output can be passed to the `server` argument in +#' [teal_transform_module()] call. Such a server function can be linked with ui and values from the +#' inputs can be used in the expression. Object names specified in the expression will be substituted +#' with the value of the respective input (matched by the name) - for example in +#' `expression(graph <- graph + ggtitle(title))` object `title` will be replaced with the value of +#' `input$title`. +#' @param expr (`language`) +#' An R call which will be evaluated within [`teal.data::teal_data`] environment. +#' @return `function(id, data)` returning `shiny` module +#' @examples +#' +#' trim_iris <- teal_transform_module( +#' label = "Simplified interactive transformator for iris", +#' datanames = "iris", +#' ui = function(id) { +#' ns <- NS(id) +#' numericInput(ns("n_rows"), "Subset n rows", value = 6, min = 1, max = 150, step = 1) +#' }, +#' server = make_teal_transform_server(expression(iris <- head(iris, n_rows))) +#' ) +#' +#' app <- init( +#' data = teal_data(iris = iris), +#' modules = example_module(transformators = trim_iris) +#' ) +#' if (interactive()) { +#' shinyApp(app$ui, app$server) +#' } +#' +#' @export +make_teal_transform_server <- function(expr) { + if (is.call(expr)) { + expr <- as.expression(expr) + } + checkmate::assert_multi_class(expr, c("call", "expression")) + + function(id, data) { + moduleServer(id, function(input, output, session) { + list_env <- reactive( + lapply(rlang::set_names(names(input)), function(x) input[[x]]) + ) + + reactive({ + call_with_inputs <- lapply(expr, function(x) { + do.call(what = substitute, args = list(expr = x, env = list_env())) + }) + eval_code(object = data(), code = as.expression(call_with_inputs)) + }) + }) + } +} + +#' Extract all `transformators` from `modules`. +#' +#' @param modules `teal_modules` or `teal_module` +#' @return A list of `teal_transform_module` nested in the same way as input `modules`. +#' @keywords internal +extract_transformators <- function(modules) { + if (inherits(modules, "teal_module")) { + modules$transformators + } else if (inherits(modules, "teal_modules")) { + lapply(modules$children, extract_transformators) + } +} diff --git a/_pkgdown.yml b/_pkgdown.yml index 14c6b437fe..94e595d09e 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -73,6 +73,7 @@ articles: contents: - creating-custom-modules - adding-support-for-reporting + - decorate-module-output - title: 📃 Technical blueprint desc: > The purpose of the blueprint is to aid new developer’s comprehension of the @@ -100,6 +101,8 @@ reference: - init - teal_data_module - teal_transform_module + - module_transform_data + - make_teal_transform_server - module_teal_with_splash - module_teal - module diff --git a/inst/WORDLIST b/inst/WORDLIST index 41727a7f93..c7d124a12e 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -29,5 +29,7 @@ summarization tabset themer theming +transformator +transformators ui uncheck diff --git a/man/example_module.Rd b/man/example_module.Rd index 7f59bc01b6..dfccaaa42b 100644 --- a/man/example_module.Rd +++ b/man/example_module.Rd @@ -7,7 +7,8 @@ example_module( label = "example teal module", datanames = "all", - transformers = list() + transformators = list(), + decorators = NULL ) } \arguments{ @@ -19,13 +20,14 @@ There are 2 reserved values that have specific behaviors: \itemize{ \item The keyword \code{"all"} includes all datasets available in the data passed to the teal application. \item \code{NULL} hides the sidebar panel completely. -\item If \code{transformers} are specified, their \code{datanames} are automatically added to this \code{datanames} +\item If \code{transformators} are specified, their \code{datanames} are automatically added to this \code{datanames} argument. }} -\item{transformers}{(\code{list} of \code{teal_data_module}) that will be applied to transform the data. -Each transform module UI will appear in the \code{teal}'s sidebar panel. -Transformers' \code{datanames} are added to the \code{datanames}. See \code{\link[=teal_transform_module]{teal_transform_module()}}.} +\item{transformators}{(\code{list} of \code{teal_transform_module}) that will be applied to transformator module's data input.} + +\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{ A \code{teal} module which can be included in the \code{modules} argument to \code{\link[=init]{init()}}. @@ -33,6 +35,13 @@ A \code{teal} module which can be included in the \code{modules} argument to \co \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} } +\details{ +This module creates an object called \code{object} that can be modified with decorators. +The \code{object} is determined by what's selected in \verb{Choose a dataset} input in UI. +The object can be anything that can be handled by \code{renderPrint()}. +See the \code{vignette("decorate-modules-output", package = "teal")} or \code{\link{teal_transform_module}} +to read more about decorators. +} \examples{ app <- init( data = teal_data(IRIS = iris, MTCARS = mtcars), diff --git a/man/extract_transformators.Rd b/man/extract_transformators.Rd new file mode 100644 index 0000000000..ea076b1bf2 --- /dev/null +++ b/man/extract_transformators.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/teal_transform_module.R +\name{extract_transformators} +\alias{extract_transformators} +\title{Extract all \code{transformators} from \code{modules}.} +\usage{ +extract_transformators(modules) +} +\arguments{ +\item{modules}{\code{teal_modules} or \code{teal_module}} +} +\value{ +A list of \code{teal_transform_module} nested in the same way as input \code{modules}. +} +\description{ +Extract all \code{transformators} from \code{modules}. +} +\keyword{internal} diff --git a/man/extract_transformers.Rd b/man/extract_transformers.Rd deleted file mode 100644 index 9af99abe12..0000000000 --- a/man/extract_transformers.Rd +++ /dev/null @@ -1,18 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/teal_data_module.R -\name{extract_transformers} -\alias{extract_transformers} -\title{Extract all \code{transformers} from \code{modules}.} -\usage{ -extract_transformers(modules) -} -\arguments{ -\item{modules}{\code{teal_modules} or \code{teal_module}} -} -\value{ -A list of \code{teal_transform_module} nested in the same way as input \code{modules}. -} -\description{ -Extract all \code{transformers} from \code{modules}. -} -\keyword{internal} diff --git a/man/make_teal_transform_server.Rd b/man/make_teal_transform_server.Rd new file mode 100644 index 0000000000..ecda077502 --- /dev/null +++ b/man/make_teal_transform_server.Rd @@ -0,0 +1,45 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/teal_transform_module.R +\name{make_teal_transform_server} +\alias{make_teal_transform_server} +\title{Make teal_transform_module's server} +\usage{ +make_teal_transform_server(expr) +} +\arguments{ +\item{expr}{(\code{language}) +An R call which will be evaluated within \code{\link[teal.data:teal_data]{teal.data::teal_data}} environment.} +} +\value{ +\verb{function(id, data)} returning \code{shiny} module +} +\description{ +A factory function to simplify creation of a \code{\link{teal_transform_module}}'s server. Specified \code{expr} +is wrapped in a shiny module function and output can be passed to the \code{server} argument in +\code{\link[=teal_transform_module]{teal_transform_module()}} call. Such a server function can be linked with ui and values from the +inputs can be used in the expression. Object names specified in the expression will be substituted +with the value of the respective input (matched by the name) - for example in +\code{expression(graph <- graph + ggtitle(title))} object \code{title} will be replaced with the value of +\code{input$title}. +} +\examples{ + +trim_iris <- teal_transform_module( + label = "Simplified interactive transformator for iris", + datanames = "iris", + ui = function(id) { + ns <- NS(id) + numericInput(ns("n_rows"), "Subset n rows", value = 6, min = 1, max = 150, step = 1) + }, + server = make_teal_transform_server(expression(iris <- head(iris, n_rows))) +) + +app <- init( + data = teal_data(iris = iris), + modules = example_module(transformators = trim_iris) +) +if (interactive()) { + shinyApp(app$ui, app$server) +} + +} diff --git a/man/module_teal_data.Rd b/man/module_teal_data.Rd index dee0b1087e..4f700e8596 100644 --- a/man/module_teal_data.Rd +++ b/man/module_teal_data.Rd @@ -15,7 +15,7 @@ srv_teal_data( data_module = function(id) NULL, modules = NULL, validate_shiny_silent_error = TRUE, - is_transformer_failed = reactiveValues() + is_transform_failed = reactiveValues() ) ui_validate_reactive_teal_data(id) @@ -37,8 +37,8 @@ srv_validate_reactive_teal_data( \item{validate_shiny_silent_error}{(\code{logical}) If \code{TRUE}, then \code{shiny.silent.error} is validated and} -\item{is_transformer_failed}{(\code{reactiveValues}) contains \code{logical} flags named after each transformer. -Help to determine if any previous transformer failed, so that following transformers can be disabled +\item{is_transform_failed}{(\code{reactiveValues}) contains \code{logical} flags named after each transformator. +Help to determine if any previous transformator failed, so that following transformators can be disabled and display a generic failure message.} \item{data}{(\verb{reactive teal_data})} diff --git a/man/module_transform_data.Rd b/man/module_transform_data.Rd index 5ae155632e..4dcd515ae3 100644 --- a/man/module_transform_data.Rd +++ b/man/module_transform_data.Rd @@ -2,40 +2,39 @@ % Please edit documentation in R/module_transform_data.R \name{module_transform_data} \alias{module_transform_data} -\alias{ui_transform_data} -\alias{srv_transform_data} +\alias{ui_transform_teal_data} +\alias{srv_transform_teal_data} \title{Module to transform \code{reactive} \code{teal_data}} \usage{ -ui_transform_data(id, transformers = list(), class = "well") +ui_transform_teal_data(id, transformators, class = "well") -srv_transform_data( +srv_transform_teal_data( id, data, - transformers = list(), - modules, - is_transformer_failed = reactiveValues() + transformators, + modules = NULL, + is_transform_failed = reactiveValues() ) } \arguments{ \item{id}{(\code{character(1)}) Module id} -\item{transformers}{(\code{list} of \code{teal_data_module}) that will be applied to transform the data. -Each transform module UI will appear in the \code{teal}'s sidebar panel. -Transformers' \code{datanames} are added to the \code{datanames}. See \code{\link[=teal_transform_module]{teal_transform_module()}}.} +\item{transformators}{(\code{list} of \code{teal_transform_module}) that will be applied to transformator module's data input.} + +\item{class}{(character(1)) CSS class to be added in the \code{div} wrapper tag.} \item{data}{(\verb{reactive teal_data})} \item{modules}{(\code{teal_modules} or \code{teal_module}) For \code{datanames} validation purpose} -\item{is_transformer_failed}{(\code{reactiveValues}) contains \code{logical} flags named after each transformer. -Help to determine if any previous transformer failed, so that following transformers can be disabled +\item{is_transform_failed}{(\code{reactiveValues}) contains \code{logical} flags named after each transformator. +Help to determine if any previous transformator failed, so that following transformators can be disabled and display a generic failure message.} } \value{ \code{reactive} \code{teal_data} } \description{ -Module calls multiple \code{\link{module_teal_data}} in sequence so that \verb{reactive teal_data} output +Module calls \code{\link[=teal_transform_module]{teal_transform_module()}} in sequence so that \verb{reactive teal_data} output from one module is handed over to the following module's input. } -\keyword{internal} diff --git a/man/teal_data_module.Rd b/man/teal_data_module.Rd index 9765ce4504..683c6d9ef9 100644 --- a/man/teal_data_module.Rd +++ b/man/teal_data_module.Rd @@ -41,7 +41,7 @@ It is possible to preserve original formatting of the \code{code} by providing a \item{data}{(\code{teal_data_module}) object} -\item{expr}{(\code{expression}) to evaluate. Must be inline code. See} +\item{expr}{(\code{expression}) to evaluate. Must be inline code. See \code{\link[=within]{within()}}} \item{...}{See \code{Details}.} } diff --git a/man/teal_modules.Rd b/man/teal_modules.Rd index 486682e5e6..1467bd0aef 100644 --- a/man/teal_modules.Rd +++ b/man/teal_modules.Rd @@ -21,21 +21,20 @@ module( datanames = "all", server_args = NULL, ui_args = NULL, - transformers = list() + transformators = list() ) modules(..., label = "root") \method{format}{teal_module}( x, - indent = 0, is_last = FALSE, parent_prefix = "", - what = c("datasets", "properties", "ui_args", "server_args", "transformers"), + what = c("datasets", "properties", "ui_args", "server_args", "transformators"), ... ) -\method{format}{teal_modules}(x, indent = 0, is_root = TRUE, is_last = FALSE, parent_prefix = "", ...) +\method{format}{teal_modules}(x, is_root = TRUE, is_last = FALSE, parent_prefix = "", ...) \method{print}{teal_module}(x, ...) @@ -79,7 +78,7 @@ There are 2 reserved values that have specific behaviors: \itemize{ \item The keyword \code{"all"} includes all datasets available in the data passed to the teal application. \item \code{NULL} hides the sidebar panel completely. -\item If \code{transformers} are specified, their \code{datanames} are automatically added to this \code{datanames} +\item If \code{transformators} are specified, their \code{datanames} are automatically added to this \code{datanames} argument. }} @@ -87,9 +86,7 @@ argument. \item{ui_args}{(named \code{list}) with additional arguments passed on to the UI function.} -\item{transformers}{(\code{list} of \code{teal_data_module}) that will be applied to transform the data. -Each transform module UI will appear in the \code{teal}'s sidebar panel. -Transformers' \code{datanames} are added to the \code{datanames}. See \code{\link[=teal_transform_module]{teal_transform_module()}}.} +\item{transformators}{(\code{list} of \code{teal_transform_module}) that will be applied to transformator module's data input.} \item{...}{\itemize{ \item For \code{modules()}: (\code{teal_module} or \code{teal_modules}) Objects to wrap into a tab. @@ -98,8 +95,6 @@ Transformers' \code{datanames} are added to the \code{datanames}. See \code{\lin \item{x}{(\code{teal_module} or \code{teal_modules}) Object to format/print.} -\item{indent}{(\code{integer(1)}) Indention level; each nested element is indented one level more.} - \item{is_last}{(\code{logical(1)}) Whether this is the last item in its parent's children list. Affects the tree branch character used (L- vs |-)} @@ -107,7 +102,7 @@ Affects the tree branch character used (L- vs |-)} used to maintain the tree structure in nested levels} \item{what}{(\code{character}) Specifies which metadata to display. -Possible values: "datasets", "properties", "ui_args", "server_args", "transformers"} +Possible values: "datasets", "properties", "ui_args", "server_args", "transformators"} \item{is_root}{(\code{logical(1)}) Whether this is the root node of the tree. Only used in format.teal_modules(). Determines whether to show "TEAL ROOT" header} @@ -159,13 +154,13 @@ in a warning. Datasets with names starting with . are ignored globally unless ex in \code{datanames}. } -\section{\code{datanames} with \code{transformers}}{ -When transformers are specified, their \code{datanames} are added to the module’s \code{datanames}, which +\section{\code{datanames} with \code{transformators}}{ +When transformators are specified, their \code{datanames} are added to the module’s \code{datanames}, which changes the behavior as follows: \itemize{ -\item If \code{module(datanames)} is \code{NULL} and the \code{transformers} have defined \code{datanames}, the sidebar -will appear showing the \code{transformers}' datasets, instead of being hidden. -\item If \code{module(datanames)} is set to specific values and any \code{transformer} has \code{datanames = "all"}, +\item If \code{module(datanames)} is \code{NULL} and the \code{transformators} have defined \code{datanames}, the sidebar +will appear showing the \code{transformators}' datasets, instead of being hidden. +\item If \code{module(datanames)} is set to specific values and any \code{transformator} has \code{datanames = "all"}, the module may receive extra datasets that could be unnecessary } } @@ -229,21 +224,21 @@ mod <- module( server = function(id, data, ...) {}, ui = function(id, ...) {}, datanames = c("ADSL", "ADTTE"), - transformers = list(), + transformators = list(), ui_args = list(a = 1, b = "b"), server_args = list(x = 5, y = list(p = 1)) ) cat(format(mod)) custom_module <- function( label = "label", ui_args = NULL, server_args = NULL, - datanames = "all", transformers = list(), bk = FALSE) { + datanames = "all", transformators = list(), bk = FALSE) { ans <- module( label, server = function(id, data, ...) {}, ui = function(id, ...) { }, datanames = datanames, - transformers = transformers, + transformators = transformators, ui_args = ui_args, server_args = server_args ) @@ -251,7 +246,7 @@ custom_module <- function( ans } -dummy_transformer <- teal_transform_module( +dummy_transformator <- teal_transform_module( label = "Dummy Transform", ui = function(id) div("(does nothing)"), server = function(id, data) { @@ -259,7 +254,7 @@ dummy_transformer <- teal_transform_module( } ) -plot_transformer <- teal_transform_module( +plot_transformator <- teal_transform_module( label = "Plot Settings", ui = function(id) div("(does nothing)"), server = function(id, data) { @@ -280,7 +275,7 @@ complete_modules <- modules( cache = TRUE, debounce = 1000 ), - transformers = list(dummy_transformer), + transformators = list(dummy_transformator), bk = TRUE ), modules( @@ -298,7 +293,7 @@ complete_modules <- modules( render_type = "svg", cache_plots = TRUE ), - transformers = list(dummy_transformer, plot_transformer), + transformators = list(dummy_transformator, plot_transformator), bk = TRUE ), modules( @@ -330,7 +325,7 @@ complete_modules <- modules( ) cat(format(complete_modules)) -cat(format(complete_modules, what = c("ui_args", "server_args", "transformers"))) +cat(format(complete_modules, what = c("ui_args", "server_args", "transformators"))) # change the module's datanames set_datanames(module(datanames = "all"), "a") diff --git a/man/teal_transform_module.Rd b/man/teal_transform_module.Rd index 931329ab6c..e2bdf8fbf4 100644 --- a/man/teal_transform_module.Rd +++ b/man/teal_transform_module.Rd @@ -1,57 +1,103 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/teal_data_module.R +% Please edit documentation in R/teal_transform_module.R \name{teal_transform_module} \alias{teal_transform_module} -\title{Data module for \code{teal} transformers.} +\title{Data module for \code{teal} transformations and output customization} \usage{ teal_transform_module( - ui = function(id) NULL, + ui = NULL, server = function(id, data) data, label = "transform module", - datanames = character(0) + datanames = "all" ) } \arguments{ \item{ui}{(\verb{function(id)}) \code{shiny} module UI function; must only take \code{id} argument} -\item{server}{(\verb{function(id, data)}) -\code{shiny} module server function; that takes \code{id} and \code{data} argument, -where the \code{id} is the module id and \code{data} is the reactive \code{teal_data} input. -The server function must return reactive expression containing \code{teal_data} object. - -The server function definition should not use \code{eventReactive} as it may lead to -unexpected behavior. -See \code{vignettes("data-transform-as-shiny-module")} for more information.} +\item{server}{(\verb{function(id, data)} or \code{expression}) +A \code{shiny} module server function that takes \code{id} and \code{data} as arguments, where \code{id} is the module id and \code{data} +is the reactive \code{teal_data} input. The \code{server} function must return a reactive expression containing a \code{teal_data} +object. For simplified syntax, use \code{\link[=make_teal_transform_server]{make_teal_transform_server()}}.} \item{label}{(\code{character(1)}) Label of the module.} \item{datanames}{(\code{character}) -Names of the datasets that are relevant for this module to evaluate. If set to \code{character(0)} -then module would receive \code{\link[=modules]{modules()}} \code{datanames}.} +Specifies the names of datasets relevant to the module. Only filters for the specified \code{datanames} will be displayed +in the filter panel. The keyword \code{"all"} can be used to display filters for all datasets. \code{datanames} are +automatically appended to the \code{\link[=modules]{modules()}} \code{datanames}.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} -Create a \code{teal_data_module} object for custom transformation of data for pre-processing -before passing the data into the module. +\code{teal_transform_module} provides a \code{shiny} module that enables data transformations within a \code{teal} application +and allows for customization of outputs generated by modules. +} +\section{Transforming Module Inputs in \code{teal}}{ +Data transformations occur after data has been filtered in \code{teal}. +The transformed data is then passed to the \code{server} of \code{\link[=teal_module]{teal_module()}} and managed by \code{teal}'s internal processes. +The primary advantage of \code{teal_transform_module} over custom modules is in its error handling, where all warnings and +errors are managed by \code{teal}, allowing developers to focus on transformation logic. + +For more details, see the vignette: \code{vignette("data-transform-as-shiny-module", package = "teal")}. } -\details{ -\code{teal_transform_module} creates a \code{\link{teal_data_module}} object to transform data in a \code{teal} -application. This transformation happens after the data has passed through the filtering activity -in teal. The transformed data is then sent to the server of the \code{\link[=teal_module]{teal_module()}}. -See vignette \code{vignette("data-transform-as-shiny-module", package = "teal")} for more details. +\section{Customizing Module Outputs}{ +\code{teal_transform_module} also allows developers to modify any object created within \code{\link[teal.data:teal_data]{teal.data::teal_data}}. +This means you can use it to customize not only datasets but also tables, listings, and graphs. +Some \code{\link{teal_modules}} permit developers to inject custom \code{shiny} modules to enhance displayed outputs. +To manage these \code{decorators} within your module, use \code{\link[=ui_transform_teal_data]{ui_transform_teal_data()}} and \code{\link[=srv_transform_teal_data]{srv_transform_teal_data()}}. +(For further guidance on managing decorators, refer to \code{ui_args} and \code{srv_args} in the vignette documentation.) + +See the vignette \code{vignette("decorate-modules-output", package = "teal")} for additional examples. } + +\section{\code{server} as a language}{ +The \code{server} function in \code{teal_transform_module} must return a reactive \code{\link[teal.data:teal_data]{teal.data::teal_data}} object. +For simple transformations without complex reactivity, the \code{server} function might look like this:s + +\if{html}{\out{
}}\preformatted{function(id, data) \{ + moduleServer(id, function(input, output, session) \{ + reactive(\{ + within( + data(), + expr = x <- subset(x, col == level), + level = input$level + ) + \}) + \}) +\} +}\if{html}{\out{
}} + +The example above can be simplified using \code{make_teal_transform_server}, where \code{level} is automatically matched to the +corresponding \code{input} parameter: + +\if{html}{\out{
}}\preformatted{make_teal_transform_server(expr = expression(x <- subset(x, col == level))) +}\if{html}{\out{
}} +} + \examples{ -my_transformers <- list( +data_transformators <- list( + teal_transform_module( + label = "Static transformator for iris", + datanames = "iris", + server = function(id, data) { + moduleServer(id, function(input, output, session) { + reactive({ + within(data(), { + iris <- head(iris, 5) + }) + }) + }) + } + ), teal_transform_module( - label = "Custom transform for iris", + label = "Interactive transformator for iris", datanames = "iris", ui = function(id) { ns <- NS(id) tags$div( - numericInput(ns("n_rows"), "Subset n rows", value = 6, min = 1, max = 150, step = 1) + numericInput(ns("n_cols"), "Show n columns", value = 5, min = 1, max = 5, step = 1) ) }, server = function(id, data) { @@ -59,9 +105,9 @@ my_transformers <- list( reactive({ within(data(), { - iris <- head(iris, num_rows) + iris <- iris[, 1:n_cols] }, - num_rows = input$n_rows + n_cols = input$n_cols ) }) }) @@ -69,4 +115,23 @@ my_transformers <- list( ) ) +output_decorator <- teal_transform_module( + server = make_teal_transform_server( + expression( + object <- rev(object) + ) + ) +) + +app <- init( + data = teal_data(iris = iris), + modules = example_module( + transformators = data_transformators, + decorators = list(output_decorator) + ) +) +if (interactive()) { + shinyApp(app$ui, app$server) +} + } diff --git a/tests/testthat/test-init.R b/tests/testthat/test-init.R index 62284d1d9b..426712345c 100644 --- a/tests/testthat/test-init.R +++ b/tests/testthat/test-init.R @@ -57,7 +57,7 @@ testthat::test_that("init throws when an empty `data` is used", { }) testthat::test_that( - "init throws warning when datanames in modules incompatible w/ datanames in data and there is no transformers", + "init throws warning when datanames in modules incompatible w/ datanames in data and there is no transformators", { testthat::expect_warning( init( @@ -70,7 +70,7 @@ testthat::test_that( ) testthat::test_that( - "init throws warning when datanames in modules incompatible w/ datanames in data and there is no transformers", + "init throws warning when datanames in modules incompatible w/ datanames in data and there is no transformators", { testthat::expect_warning( init( @@ -83,7 +83,7 @@ testthat::test_that( ) testthat::test_that( - "init does not throw warning when datanames in modules incompatible w/ datanames in data and there are transformers", + "init doesn't throw warning when datanames in modules incompatible w/ datanames in data and there are transformators", { testthat::expect_no_warning( init( @@ -91,7 +91,7 @@ testthat::test_that( modules = list( example_module( datanames = "iris", - transformers = list( + transformators = list( teal_transform_module( ui = function(id) NULL, server = function(id, data) { diff --git a/tests/testthat/test-module_teal.R b/tests/testthat/test-module_teal.R index 849b0ecd7f..b4eced1301 100644 --- a/tests/testthat/test-module_teal.R +++ b/tests/testthat/test-module_teal.R @@ -573,7 +573,7 @@ testthat::describe("srv_teal teal_modules", { trimws( rvest::html_text2( rvest::read_html( - output[["teal_modules-module_1-validate_datanames-shiny_warnings-message"]]$html + output[["teal_modules-module_1-validate_datanames-message"]]$html ) ) ), @@ -602,11 +602,13 @@ testthat::describe("srv_teal teal_modules", { ), expr = { session$setInputs("teal_modules-active_tab" = "module_1") + session$flushReact() + testthat::expect_equal( trimws( rvest::html_text2( rvest::read_html( - output[["teal_modules-module_1-validate_datanames-shiny_warnings-message"]]$html + output[["teal_modules-module_1-validate_datanames-message"]]$html ) ) ), @@ -635,7 +637,7 @@ testthat::describe("srv_teal teal_modules", { trimws( rvest::html_text2( rvest::read_html( - output[["teal_modules-module_1-validate_datanames-shiny_warnings-message"]]$html + output[["teal_modules-module_1-validate_datanames-message"]]$html ) ) ), @@ -663,7 +665,7 @@ testthat::describe("srv_teal teal_modules", { trimws( rvest::html_text2( rvest::read_html( - output[["teal_modules-module_1-validate_datanames-shiny_warnings-message"]]$html + output[["teal_modules-module_1-validate_datanames-message"]]$html ) ) ), @@ -690,7 +692,7 @@ testthat::describe("srv_teal teal_modules", { trimws( rvest::html_text2( rvest::read_html( - output[["teal_modules-module_1-validate_datanames-shiny_warnings-message"]]$html + output[["teal_modules-module_1-validate_datanames-message"]]$html ) ) ), @@ -717,7 +719,7 @@ testthat::describe("srv_teal teal_modules", { trimws( rvest::html_text2( rvest::read_html( - output[["validate-shiny_warnings-message"]]$html + output[["datanames_warning-message"]]$html ) ) ), @@ -794,7 +796,7 @@ testthat::describe("srv_teal teal_modules", { ) }) - testthat::it("receives all transform datasets if module$datanames == 'all'", { + testthat::it("receives all transformator datasets if module$datanames == 'all'", { shiny::testServer( app = srv_teal, args = list( @@ -810,7 +812,7 @@ testthat::describe("srv_teal teal_modules", { module( label = "module_1", server = function(id, data) data, - transformers = list( + transformators = list( teal_transform_module( label = "Dummy", server = function(id, data) { @@ -847,7 +849,7 @@ testthat::describe("srv_teal teal_modules", { module( label = "module_1", server = function(id, data) data, - transformers = list( + transformators = list( teal_transform_module( label = "Dummy", server = function(id, data) { @@ -906,7 +908,7 @@ testthat::describe("srv_teal teal_modules", { module( label = "module_1", server = function(id, data) data, - transformers = list( + transformators = list( teal_transform_module( label = "Dummy", ui = function(id) div("(does nothing)"), @@ -929,7 +931,7 @@ testthat::describe("srv_teal teal_modules", { ) }) - testthat::it("does not receive transform datasets not specified in transform$datanames nor modue$datanames", { + testthat::it("does not receive transformator datasets not specified in transform$datanames nor modue$datanames", { shiny::testServer( app = srv_teal, args = list( @@ -945,7 +947,7 @@ testthat::describe("srv_teal teal_modules", { module( label = "module_1", server = function(id, data) data, - transformers = list( + transformators = list( teal_transform_module( label = "Dummy", server = function(id, data) { @@ -1609,7 +1611,7 @@ testthat::describe("srv_teal data reload", { }) }) -testthat::describe("srv_teal teal_module(s) transformer", { +testthat::describe("srv_teal teal_module(s) transformator", { testthat::it("evaluates custom qenv call and pass updated teal_data to the module", { shiny::testServer( app = srv_teal, @@ -1620,7 +1622,7 @@ testthat::describe("srv_teal teal_module(s) transformer", { module( label = "module_1", server = function(id, data) data, - transformers = transform_list[c("iris", "mtcars")] + transformators = transform_list[c("iris", "mtcars")] ) ) ), @@ -1649,7 +1651,7 @@ testthat::describe("srv_teal teal_module(s) transformer", { module( label = "module_1", server = function(id, data) data, - transformers = transform_list[c("iris", "mtcars")] + transformators = transform_list[c("iris", "mtcars")] ) ) ), @@ -1693,7 +1695,7 @@ testthat::describe("srv_teal teal_module(s) transformer", { module( label = "module_1", server = function(id, data) data, - transformers = transform_list[c("iris", "mtcars")] + transformators = transform_list[c("iris", "mtcars")] ) ) ), @@ -1743,7 +1745,7 @@ testthat::describe("srv_teal teal_module(s) transformer", { label = "module_1", server = function(id, data) data, datanames = c("iris", "data_from_transform"), - transformers = list( + transformators = list( teal_transform_module( ui = function(id) NULL, server = function(id, data) { @@ -1770,7 +1772,7 @@ testthat::describe("srv_teal teal_module(s) transformer", { ) }) - testthat::it("throws warning when transformer return reactive.event", { + testthat::it("throws a warning when transformator returns reactive.event", { testthat::expect_warning( testServer( app = srv_teal, @@ -1780,7 +1782,7 @@ testthat::describe("srv_teal teal_module(s) transformer", { modules = modules( module( server = function(id, data) data, - transformers = list( + transformators = list( teal_transform_module( ui = function(id) textInput("a", "an input"), server = function(id, data) eventReactive(input$a, data()) @@ -1798,7 +1800,7 @@ testthat::describe("srv_teal teal_module(s) transformer", { ) }) - testthat::it("fails when transformer doesn't return reactive", { + testthat::it("fails when transformator doesn't return reactive", { testthat::expect_warning( # error decorator is mocked to avoid showing the trace error during the # test. @@ -1812,7 +1814,7 @@ testthat::describe("srv_teal teal_module(s) transformer", { modules = modules( module( server = function(id, data) data, - transformers = list( + transformators = list( teal_transform_module( ui = function(id) NULL, server = function(id, data) "whatever" @@ -1835,7 +1837,7 @@ testthat::describe("srv_teal teal_module(s) transformer", { ) }) - testthat::it("pauses when transformer throws validation error", { + testthat::it("pauses when transformator throws validation error", { shiny::testServer( app = srv_teal, args = list( @@ -1845,7 +1847,7 @@ testthat::describe("srv_teal teal_module(s) transformer", { module( label = "module_1", server = function(id, data) data, - transformers = list( + transformators = list( teal_transform_module( ui = function(id) NULL, server = function(id, data) { @@ -1863,7 +1865,7 @@ testthat::describe("srv_teal teal_module(s) transformer", { ) }) - testthat::it("pauses when transformer throws validation error", { + testthat::it("pauses when transformator throws validation error", { shiny::testServer( app = srv_teal, args = list( @@ -1873,7 +1875,7 @@ testthat::describe("srv_teal teal_module(s) transformer", { module( label = "module_1", server = function(id, data) data, - transformers = list( + transformators = list( teal_transform_module( ui = function(id) NULL, server = function(id, data) { @@ -1891,7 +1893,7 @@ testthat::describe("srv_teal teal_module(s) transformer", { ) }) - testthat::it("pauses when transformer throws qenv error", { + testthat::it("pauses when transformator throws qenv error", { shiny::testServer( app = srv_teal, args = list( @@ -1901,7 +1903,7 @@ testthat::describe("srv_teal teal_module(s) transformer", { module( label = "module_1", server = function(id, data) data, - transformers = list( + transformators = list( teal_transform_module( ui = function(id) NULL, server = function(id, data) { @@ -1929,7 +1931,7 @@ testthat::describe("srv_teal teal_module(s) transformer", { module( label = "module_1", server = function(id, data) data, - transformers = list( + transformators = list( teal_transform_module( ui = function(id) NULL, server = function(id, data) { @@ -1946,6 +1948,116 @@ testthat::describe("srv_teal teal_module(s) transformer", { } ) }) + + testthat::it("changes module output for a module with a static decorator", { + output_decorator <- teal_transform_module( + label = "output_decorator", + server = make_teal_transform_server(expression(object <- rev(object))) + ) + + shiny::testServer( + app = srv_teal, + args = list( + id = "test", + data = teal.data::teal_data(object = iris), + modules = modules(example_module("mod1", decorators = list(output_decorator))) + ), + expr = { + session$setInputs(`teal_modules-active_tab` = "mod1") + session$setInputs(`teal_modules-mod1-module-dataname` = "object") + session$flushReact() + testthat::expect_identical( + modules_output$mod1()()[["object"]], + rev(iris) + ) + } + ) + }) + + + testthat::it("changes module output for a module with a decorator that is a function of an object name", { + decorator_name <- function(output_name, label) { + teal_transform_module( + label = label, + server = function(id, data) { + moduleServer(id, function(input, output, session) { + reactive({ + within( + data(), + output_name <- paste0(output_name, " lorem ipsum"), + text = input$text, + output_name = as.name(output_name) + ) + }) + }) + } + ) + } + + shiny::testServer( + app = srv_teal, + args = list( + id = "test", + data = teal.data::teal_data(x1 = "ABC"), + modules = modules( + example_module( + "mod1", + decorators = list(decorator_name(output_name = "object", label = "decorator_name")) + ) + ) + ), + expr = { + session$setInputs(`teal_modules-active_tab` = "mod1") + session$setInputs(`teal_modules-mod1-module-dataname` = "x1") + session$flushReact() + + testthat::expect_identical(modules_output$mod1()()[["object"]], "ABC lorem ipsum") + } + ) + }) + + testthat::it("changes module output for a module with an interactive decorator", { + decorator_name <- function(output_name, label) { + teal_transform_module( + label = label, + server = function(id, data) { + moduleServer(id, function(input, output, session) { + reactive({ + req(data(), input$text) + within( + data(), + output_name <- paste0(output_name, " ", text), + text = input$text, + output_name = as.name(output_name) + ) + }) + }) + } + ) + } + + shiny::testServer( + app = srv_teal, + args = list( + id = "test", + data = teal.data::teal_data(x1 = "ABC"), + modules = modules( + example_module( + "mod1", + decorators = list(decorator_name(output_name = "object", label = "decorator_name")) + ) + ) + ), + expr = { + session$setInputs(`teal_modules-active_tab` = "mod1") + session$setInputs(`teal_modules-mod1-module-dataname` = "x1") + session$setInputs(`teal_modules-mod1-module-decorate-transform_1-transform-text` = "lorem ipsum dolor") + session$flushReact() + + testthat::expect_identical(modules_output$mod1()()[["object"]], "ABC lorem ipsum dolor") + } + ) + }) }) testthat::describe("srv_teal summary table", { @@ -2139,7 +2251,7 @@ testthat::describe("srv_teal summary table", { ) }) - testthat::it("reflects transform adding new dataset if specified in module", { + testthat::it("reflects transformator adding new dataset if specified in module", { shiny::testServer( app = srv_teal, args = list( @@ -2149,7 +2261,7 @@ testthat::describe("srv_teal summary table", { module( "module_1", server = function(id, data) data, - transformers = teal_transform_module( + transformators = teal_transform_module( datanames = character(0), server = function(id, data) { moduleServer(id, function(input, output, session) { @@ -2177,7 +2289,7 @@ testthat::describe("srv_teal summary table", { ) }) - testthat::it("reflects transform filtering", { + testthat::it("reflects transformator filtering", { testthat::it("displays parent's Subjects with count based on primary key", { shiny::testServer( app = srv_teal, @@ -2188,7 +2300,7 @@ testthat::describe("srv_teal summary table", { module( "module_1", server = function(id, data) data, - transformers = transform_list["iris"] + transformators = transform_list["iris"] ) ) ), @@ -2281,7 +2393,7 @@ testthat::describe("srv_teal summary table", { ) }) - testthat::test_that("summary table displays MAE dataset added in transforms", { + testthat::it("summary table displays MAE dataset added in transformators", { data <- within(teal.data::teal_data(), { iris <- iris mtcars <- mtcars @@ -2292,7 +2404,7 @@ testthat::describe("srv_teal summary table", { args = list( id = "test", data = data, - modules = modules(module("module_1", server = function(id, data) data, datanames = "all", transformers = list( + modules = modules(module("module_1", server = function(id, data) data, datanames = "all", transformators = list( teal_transform_module( server = function(id, data) { reactive({ diff --git a/tests/testthat/test-modules.R b/tests/testthat/test-modules.R index 65295a363d..5a1da7b37f 100644 --- a/tests/testthat/test-modules.R +++ b/tests/testthat/test-modules.R @@ -120,7 +120,10 @@ testthat::test_that("module() returns list of class 'teal_module' containing inp ui_args = NULL ) testthat::expect_s3_class(test_module, "teal_module") - testthat::expect_named(test_module, c("label", "server", "ui", "datanames", "server_args", "ui_args", "transformers")) + testthat::expect_named( + test_module, + c("label", "server", "ui", "datanames", "server_args", "ui_args", "transformators") + ) testthat::expect_identical(test_module$label, "aaa1") testthat::expect_identical(test_module$server, call_module_server_fun) testthat::expect_identical(test_module$ui, ui_fun1) @@ -506,15 +509,41 @@ testthat::test_that("format.teal_modules returns proper structure", { appended_mods <- append_module(mods, mod3) - testthat::expect_equal( - gsub("\033\\[[0-9;]*m", "", format(appended_mods)), - "TEAL ROOT\n |- a\n | |- Datasets : all\n | |- Properties:\n | | |- Bookmarkable : FALSE\n | | L- Reportable : FALSE\n | |- UI Arguments : \n | |- Server Arguments : \n | L- Transformers : \n |- c\n | |- Datasets : all\n | |- Properties:\n | | |- Bookmarkable : FALSE\n | | L- Reportable : FALSE\n | |- UI Arguments : \n | |- Server Arguments : \n | L- Transformers : \n L- c\n |- Datasets : all\n |- Properties:\n | |- Bookmarkable : FALSE\n | L- Reportable : FALSE\n |- UI Arguments : \n |- Server Arguments : \n L- Transformers : \n" # nolint: line_length + testthat::expect_setequal( + strsplit(gsub("\033\\[[0-9;]*m", "", format(appended_mods)), "\n")[[1]], + c( + "TEAL ROOT", + " |- a", + " | |- Datasets : all", + " | |- Properties:", + " | | |- Bookmarkable : FALSE", + " | | L- Reportable : FALSE", + " | |- UI Arguments : ", + " | |- Server Arguments : ", + " | L- Transformators : ", + " |- c", + " | |- Datasets : all", + " | |- Properties:", + " | | |- Bookmarkable : FALSE", + " | | L- Reportable : FALSE", + " | |- UI Arguments : ", + " | |- Server Arguments : ", + " | L- Transformators : ", + " L- c", + " |- Datasets : all", + " |- Properties:", + " | |- Bookmarkable : FALSE", + " | L- Reportable : FALSE", + " |- UI Arguments : ", + " |- Server Arguments : ", + " L- Transformators : " + ) ) }) -testthat::test_that("module datanames is appended by its transformers datanames", { - transformer_w_datanames <- teal_transform_module( +testthat::test_that("module datanames is appended by its transformators datanames", { + transformator_w_datanames <- teal_transform_module( ui = function(id) NULL, server = function(id, data) { moduleServer(id, function(input, output, session) { @@ -529,12 +558,12 @@ testthat::test_that("module datanames is appended by its transformers datanames" datanames = c("a", "b") ) - out <- module(datanames = "c", transformers = list(transformer_w_datanames)) + out <- module(datanames = "c", transformators = list(transformator_w_datanames)) testthat::expect_identical(out$datanames, c("c", "a", "b")) }) -testthat::test_that("module datanames stays 'all' regardless of transformers", { - transformer_w_datanames <- teal_transform_module( +testthat::test_that("module datanames stays 'all' regardless of transformators", { + transformator_w_datanames <- teal_transform_module( ui = function(id) NULL, server = function(id, data) { moduleServer(id, function(input, output, session) { @@ -549,6 +578,6 @@ testthat::test_that("module datanames stays 'all' regardless of transformers", { datanames = c("a", "b") ) - out <- module(datanames = "all", transformers = list(transformer_w_datanames)) + out <- module(datanames = "all", transformators = list(transformator_w_datanames)) testthat::expect_identical(out$datanames, "all") }) diff --git a/tests/testthat/test-shinytest2-decorators.R b/tests/testthat/test-shinytest2-decorators.R new file mode 100644 index 0000000000..dafd0d7c19 --- /dev/null +++ b/tests/testthat/test-shinytest2-decorators.R @@ -0,0 +1,120 @@ +testthat::skip_if_not_installed("shinytest2") +testthat::skip_if_not_installed("rvest") + +testthat::test_that("e2e: module with decorator UI and output is modified interactively upon changes in decorator", { + skip_if_too_deep(5) + + interactive_decorator <- teal_transform_module( + ui = function(id) { + ns <- NS(id) + div( + textInput(ns("append_text"), "Append text", value = "random text") + ) + }, + server = function(id, data) { + moduleServer(id, function(input, output, session) { + reactive({ + req(data()) + within(data(), + { + object <- paste0(object, append_text) + }, + append_text = input$append_text + ) + }) + }) + } + ) + + app <- TealAppDriver$new( + data = teal.data::teal_data(x = "Text Input"), + modules = example_module(label = "Example Module", decorators = list(interactive_decorator)) + ) + + app$navigate_teal_tab("Example Module") + + input_id <- Reduce( + shiny::NS, + c("decorate", "transform_1", "transform", "append_text") + ) + + testthat::expect_true( + app$is_visible(sprintf("#%s-%s", app$active_module_ns(), input_id)) + ) + + testthat::expect_identical( + app$active_module_element_text( + paste0(input_id, "-label") + ), + "Append text" + ) + + testthat::expect_identical( + app$get_active_module_input(input_id), + "random text" + ) + + testthat::expect_identical( + app$get_active_module_output("text"), + paste0('[1] \"', "Text Input", "random text", '\"'), + "[1] \"Text Inputrandom text\"" + ) + + app$set_active_module_input(input_id, "new text") + + testthat::expect_identical( + app$get_active_module_output("text"), + paste0('[1] \"', "Text Input", "new text", '\"'), + "[1] \"Text Inputrandom text\"" + ) + + app$stop() +}) + +testthat::test_that("e2e: module with decorator, where server fails, shows shiny error message", { + skip_if_too_deep(5) + failing_decorator <- teal_transform_module( + ui = function(id) { + ns <- NS(id) + div( + textInput(ns("append_text"), "Append text", value = "random text") + ) + }, + server = function(id, data) { + moduleServer(id, function(input, output, session) { + reactive(stop("This is error")) + }) + } + ) + app <- TealAppDriver$new( + data = teal.data::teal_data(iris = iris), + modules = example_module(label = "Example Module", decorators = list(failing_decorator)) + ) + + app$navigate_teal_tab("Example Module") + + input_id <- Reduce( + shiny::NS, + c("decorate", "transform_1", "silent_error", "message") + ) + + testthat::expect_true(app$is_visible(sprintf("#%s-%s", app$active_module_ns(), input_id))) + + app$expect_validation_error() + + testthat::expect_setequal( + strsplit(app$active_module_element_text(input_id), "\n")[[1]], + c( + "Shiny error when executing the `data` module.", + "This is error", + "Check your inputs or contact app developer if error persists." + ) + ) + + testthat::expect_setequal( + app$get_active_module_output("text")$type, + c("shiny.silent.error", "validation") + ) + + app$stop() +}) diff --git a/tests/testthat/test-shinytest2-show-rcode.R b/tests/testthat/test-shinytest2-show-rcode.R index a7504573f0..c2d8deda1d 100644 --- a/tests/testthat/test-shinytest2-show-rcode.R +++ b/tests/testthat/test-shinytest2-show-rcode.R @@ -50,7 +50,9 @@ testthat::test_that("e2e: teal app initializes with Show R Code modal", { sprintf('stopifnot(rlang::hash(iris) == "%s") # @linksto iris', rlang::hash(iris)), sprintf('stopifnot(rlang::hash(mtcars) == "%s") # @linksto mtcars', rlang::hash(mtcars)), ".raw_data <- list2env(list(iris = iris, mtcars = mtcars))", - "lockEnvironment(.raw_data) # @linksto .raw_data" + "lockEnvironment(.raw_data) # @linksto .raw_data", + "object <- iris", + "object" ) ) diff --git a/tests/testthat/test-teal_data_module.R b/tests/testthat/test-teal_data_module.R index 0361ea4ea4..d751cdc000 100644 --- a/tests/testthat/test-teal_data_module.R +++ b/tests/testthat/test-teal_data_module.R @@ -22,11 +22,3 @@ testthat::test_that("teal_data_module throws when server has other formals than ".*formal arguments.*" ) }) - - -testthat::test_that("teal_transform_module doesn't accept datanames = 'all'", { - testthat::expect_error( - teal_transform_module(datanames = "all"), - "can't have datanames property equal to 'all'" - ) -}) diff --git a/tests/testthat/test-teal_transform_module.R b/tests/testthat/test-teal_transform_module.R new file mode 100644 index 0000000000..74c8837acb --- /dev/null +++ b/tests/testthat/test-teal_transform_module.R @@ -0,0 +1,80 @@ +testthat::describe("make_teal_transform_server produces a valid teal_transform_module", { + testthat::it("expression", { + label <- "output_decorator" + output_decorator <- teal_transform_module( + label = label, + server = make_teal_transform_server( + expression(data1 <- rev(data1)) + ) + ) + + shiny::testServer( + app = srv_transform_teal_data, + args = list( + id = "test", + data = reactive(teal.data::teal_data(data1 = iris, data2 = mtcars)), + transformators = output_decorator + ), + expr = { + session$flushReact() + testthat::expect_identical(module_output()[["data1"]], rev(iris)) + } + ) + }) + + testthat::it("quote", { + label <- "output_decorator" + output_decorator <- teal_transform_module( + label = label, + server = make_teal_transform_server( + quote(data1 <- rev(data1)) + ) + ) + + shiny::testServer( + app = srv_transform_teal_data, + args = list( + id = "test", + data = reactive(teal.data::teal_data(data1 = iris, data2 = mtcars)), + transformators = output_decorator + ), + expr = { + session$flushReact() + testthat::expect_identical(module_output()[["data1"]], rev(iris)) + } + ) + }) +}) + +testthat::test_that( + "ui_transform_teal_data and srv_transform_teal_data have the same namespace for transform module", + { + ttm <- teal_transform_module( + ui = function(id) tags$div(id = NS(id, "a_div"), "a div"), + server = function(id, data) { + moduleServer(id, function(input, output, session) { + full_id <- session$ns("a_div") + reactive(within(data(), id <- full_id, full_id = full_id)) + }) + } + ) + + initial_id <- "a-path-to-an-inner-namespace" + ui <- ui_transform_teal_data(initial_id, ttm) + # Find element that ends in "-a_div" + expected_id <- unname(unlist(ui)[grepl(".*-a_div$", unlist(ui))][1]) + + testServer( + app = srv_transform_teal_data, + args = list( + id = initial_id, + data = reactive(within(teal_data(), iris <- iris)), + transformators = ttm + ), + expr = { + session$flushReact() + testthat::expect_equal(module_output()$id, expected_id) + } + ) + } +) diff --git a/vignettes/data-transform-as-shiny-module.Rmd b/vignettes/data-transform-as-shiny-module.Rmd index be8b202019..da6764dfdc 100644 --- a/vignettes/data-transform-as-shiny-module.Rmd +++ b/vignettes/data-transform-as-shiny-module.Rmd @@ -12,14 +12,14 @@ vignette: > ## Introduction -`teal` version `0.16` introduced new argument in `teal::module` called `transformers`. -This argument allows to pass a `list` of `teal_data_module` objects that are created using `teal_transform_module()` function. +[`teal_transform_module()`](https://insightsengineering.github.io/teal/latest-tag/reference/teal_transform_module.html) is a Shiny module that takes `ui` and `server` arguments. When provided, `teal` will execute data transformations for the specified module when it is loaded and whenever the data changes. `server` extend the logic behind data manipulations, where `ui` extends filter panel with new UI elements that orchestrate the transformator inputs. + +`teal` version `0.16` introduced a new, optional argument in `teal::module` named `transformators`. +This argument allows to pass a `list` of `"teal_data_module"` class of objects created using [`teal_transform_module()`](https://insightsengineering.github.io/teal/latest-tag/reference/teal_transform_module.html) function. The main benefit of `teal_transform_module()` is the ability to transform data before passing it to the module. This feature allows to extend the regular behavior of existing modules by specifying custom data operations on data inside this module. -`teal_transform_module()` is a Shiny module that takes `ui` and `server` arguments. When provided, `teal` will execute data transformations for the specified module when it is loaded and whenever the data changes. `server` extend the logic behind data manipulations, where `ui` extends filter panel with new UI elements that orchestrate the transformer inputs. - This vignette presents the way on how to manage custom data transformations in `teal` apps. ## Creating your first custom data transformation module @@ -46,7 +46,7 @@ if (interactive()) { } ``` -### Single Transformer +### Single transformator Let's create a simple `teal_transform_module` that returns the first `n` number of rows of `iris` based on the user input. @@ -59,9 +59,9 @@ data <- within(teal_data(), { mtcars <- mtcars }) -my_transformers <- list( +my_transformators <- list( teal_transform_module( - label = "Custom transform for iris", + label = "Custom transformator for iris", ui = function(id) { ns <- NS(id) tags$div( @@ -85,7 +85,7 @@ my_transformers <- list( app <- init( data = data, - modules = teal::example_module(transformers = my_transformers) + modules = teal::example_module(transformators = my_transformators) ) if (interactive()) { @@ -97,9 +97,9 @@ _Note_: It is recommended to return `reactive()` with `teal_data()` in `server` If you are planning on using `eventReactive()` in the server, the event should include `data()` _(example `eventReactive(list(input$a, data()), {...})`)_. More in [this discussion](https://github.com/insightsengineering/teal/issues/1303#issuecomment-2286239832). -### Multiple Transformers +### Multiple transformators -Note that we can add multiple `teal` transformers by including `teal_transform_module` in a list. +Note that we can add multiple `teal` transformators by including `teal_transform_module` in a list. Let's add another transformation to the `mtcars` dataset that creates a column with `rownames` of `mtcars`. Note that this module does not have interactive UI elements. @@ -110,9 +110,9 @@ data <- within(teal_data(), { mtcars <- mtcars }) -my_transformers <- list( +my_transformators <- list( teal_transform_module( - label = "Custom transform for iris", + label = "Custom transformator for iris", ui = function(id) { ns <- NS(id) tags$div( @@ -133,7 +133,7 @@ my_transformers <- list( } ), teal_transform_module( - label = "Custom transform for mtcars", + label = "Custom transformator for mtcars", ui = function(id) { ns <- NS(id) tags$div( @@ -155,7 +155,7 @@ my_transformers <- list( app <- init( data = data, - modules = teal::example_module(transformers = my_transformers) + modules = teal::example_module(transformators = my_transformators) ) if (interactive()) { diff --git a/vignettes/decorate-module-output.Rmd b/vignettes/decorate-module-output.Rmd new file mode 100644 index 0000000000..ade9479644 --- /dev/null +++ b/vignettes/decorate-module-output.Rmd @@ -0,0 +1,715 @@ +--- +title: "Customizing Module Output" +author: "NEST CoreDev" +output: + rmarkdown::html_vignette: + toc: true +vignette: > + %\VignetteIndexEntry{Customizing Module Output} + %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} +--- + +## Introduction + +`teal` is a powerful `shiny`-based framework with built-in modules for interactive data analysis. +This document outlines the customization options available for modifying the output of `teal` modules. +You will learn how to use [`teal_transform_module`](https://insightsengineering.github.io/teal/latest-tag/reference/teal_transform_module.html) to modify and enhance the objects created by `teal::modules()`, +enabling you to tailor the outputs to your specific requirements without rewriting the original module code. + +## Decorators + +In programming, **decoration** refers to the process of modifying an object while preserving its original class. For instance, given an object `x` of class `"my_class"`, a function `foo(x)` is considered a **decorator function** if it modifies `x` and returns an object that retains the same class. In this context, `x` is referred to as the **decorated object**, and `foo()` is the **decorator function** or **decorator**. Decorators can perform a variety of operations, such as adding new methods or modifying data, while ensuring the object remains compatible with its original usage. + +In the context of `teal` applications, decoration is specifically used to modify module outputs, such as plots or tables. For example, consider a decorator function `add_title(x, )` that takes a `ggplot2` plot object (`x`) as input, applies a title modification, and returns a modified `ggplot2` plot object. This function qualifies as a decorator because it preserves the original class of the input object. Conversely, a function like `create_plot(, , )`, which generates a new plot object, is **not** a decorator, as it produces an output of a different class. + +Preserving the object's class during decoration is essential for compatibility. It ensures that the subsequent "display" logic can seamlessly handle both decorated and non-decorated objects. + +The decoration process can vary in complexity: + +- **Simple Decorations**: Single-step modifications, such as a single method call that does not require additional data. +- **Complex Decorations**: Multi-step operations that may involve interdependent transformations, potentially requiring input from dedicated `shiny` UI elements. + +This powerful functionality empowers application developers to significantly customize outputs beyond the default capabilities provided by existing module parameters. Decorations allow for advanced modifications, enabling highly tailored and dynamic user experiences in `teal` applications. + +## Requirements and Limitations + +To use decorators effectively, certain requirements must be met: + +1. **Module Support**: While `teal` provides the core functionality for decorators, the module must explicitly support this functionality. Developers should ensure that the module has been designed to work with decorators. +2. **Matching Object Names**: Decorators must reference object names that align with the internal naming conventions of the module. Each module may use different names for its output objects, such as `plot` or `table`. This alignment is critical for successful decoration. + +It is recommended to review the module documentation or source code to understand its internal object naming before applying decorators. + +## Decorators in `teal` + +One of ways of adjusting input data or customizing module outputs in `teal` is the usage of `transformators` +created through `teal_transform_module`. + +In below chapter we will present how to create the simplest static decorator with just a server part. Later, we will +present examples on more advanced usage, where decorators contain UI. You will also learn about a convenience +function that makes it easier to write decorators, called [`make_teal_transform_server`](https://insightsengineering.github.io/teal/latest-tagx/reference/make_teal_transform_server.html). The chapter ends with an +example module that utilizes decorators and a snippet that uses this module in `teal` application. + +### Server + +The simplest way to create a decorator is to use [`teal_transform_module`](https://insightsengineering.github.io/teal/latest-tag/reference/teal_transform_module.html) with only `server` argument provided (i.e. without UI part). +This approach adds functionality solely to the server code of the module. +In the following example, we assume that the module contains an object (of class `ggplot2`) named `plot`. +We modify the title and x-axis label of plot: + +```{r} +library(teal) +static_decorator <- teal_transform_module( + label = "Static decorator", + server = function(id, data) { + moduleServer(id, function(input, output, session) { + reactive({ + req(data()) + within(data(), { + plot <- plot + + ggtitle("This is title") + + xlab("x axis") + }) + }) + }) + } +) +``` + +To simplify the repetitive elements of writing new decorators +(e.g., `function(id, data), moduleServer, reactive, within(data, ...)`), +you can use the [`make_teal_transform_server()`](https://insightsengineering.github.io/teal/latest-tag/reference/make_teal_transform_server.html) convenience function, which takes a `language` as input: + +```{r} +static_decorator_lang <- teal_transform_module( + label = "Static decorator (language)", + server = make_teal_transform_server( + expression( + plot <- plot + + ggtitle("This is title") + + xlab("x axis title") + ) + ) +) +``` + +### UI + +To create a decorator with user interactivity, you can add (optional) UI part and use it in server accordingly (i.e. a typical `shiny` module). +In the example below, the x-axis title is set dynamically via a `textInput`, allowing users to specify their preferred label. +Note how the input parameters are passed to the [`within`](https://insightsengineering.github.io/teal/latest-tag/reference/teal_data_module.html) function using its `...` argument. + +```{r} +interactive_decorator <- teal_transform_module( + label = "Interactive decorator", + ui = function(id) { + ns <- NS(id) + div( + textInput(ns("x_axis_title"), "X axis title", value = "x axis") + ) + }, + server = function(id, data) { + moduleServer(id, function(input, output, session) { + reactive({ + req(data()) + within(data(), + { + plot <- plot + + ggtitle("This is title") + + xlab(my_title) + }, + my_title = input$x_axis_title + ) + }) + }) + } +) +``` + +As in the earlier examples, [`make_teal_transform_server()`](https://insightsengineering.github.io/teal/latest-tag/reference/make_teal_transform_server.html) can simplify the creation of the server component. +This wrapper requires you to use `input` object names directly in the expression - note that we have `xlab(x_axis_table)` and not `my_title = input$x_axis_title` together with `xlab(my_title)`. + +```{r} +interactive_decorator_lang <- teal_transform_module( + label = "Interactive decorator (language)", + ui = function(id) { + ns <- NS(id) + div( + textInput(ns("x_axis_title"), "X axis title", value = "x axis") + ) + }, + server = make_teal_transform_server( + expression( + plot <- plot + + ggtitle("This is title") + + xlab(x_axis_title) + ) + ) +) +``` + +## Handling Various Object Names + +`teal_transform_module` relies on the names of objects created within a module. +Writing a decorator that applies to any module can be challenging because different modules may use different object names. +It is recommended to create a library of decorator functions that can be adapted to the specific object names used in `teal` modules. +In the following example, focus on the `output_name` parameter to see how decorator can be applied to multiple modules: + +```{r} +gg_xlab_decorator <- function(output_name) { + teal_transform_module( + label = "X-axis decorator", + ui = function(id) { + ns <- NS(id) + div( + textInput(ns("x_axis_title"), "X axis title", value = "x axis") + ) + }, + server = function(id, data) { + moduleServer(id, function(input, output, session) { + reactive({ + req(data()) + within(data(), + { + output_name <- output_name + + xlab(x_axis_title) + }, + x_axis_title = input$x_axis_title, + output_name = as.name(output_name) + ) + }) + }) + } + ) +} +``` + +Decorator failures are managed by an internal `teal` mechanism called **trigger on success**, which ensures that the `data` +object within the module remains intact. +If a decorator fails, the outputs will not be shown, and an appropriate error message will be displayed. + +```{r} +failing_decorator <- teal_transform_module( + label = "Failing decorator", + ui = function(id) { + ns <- NS(id) + div( + textInput(ns("x_axis_title"), "X axis title", value = "x axis") + ) + }, + server = function(id, data) { + moduleServer(id, function(input, output, session) { + reactive(stop("\nThis is an error produced by decorator\n")) + }) + } +) +``` + +## Decorating Plots + +### Example Module + +To include decorators in a `teal` module, pass them as arguments (`ui_args` and `server_args`) to the module’s `ui` and +`server` components, where they will be used by `ui/srv_teal_transform_module`. + +Please find an example module for the sake of this article: + + +```{r} +tm_decorated_plot <- function(label = "module", transformators = list(), decorators = NULL) { + checkmate::assert_list(decorators, "teal_transform_module", null.ok = TRUE) + + module( + label = label, + ui = function(id, decorators) { + ns <- NS(id) + div( + selectInput(ns("dataname"), label = "select dataname", choices = NULL), + selectInput(ns("x"), label = "select x", choices = NULL), + selectInput(ns("y"), label = "select y", choices = NULL), + ui_transform_teal_data(ns("decorate"), transformators = decorators), + plotOutput(ns("plot")), + verbatimTextOutput(ns("text")) + ) + }, + server = function(id, data, decorators) { + moduleServer(id, function(input, output, session) { + observeEvent(data(), { + updateSelectInput(inputId = "dataname", choices = names(data())) + }) + + observeEvent(input$dataname, { + req(input$dataname) + updateSelectInput(inputId = "x", choices = colnames(data()[[input$dataname]])) + updateSelectInput(inputId = "y", choices = colnames(data()[[input$dataname]])) + }) + + dataname <- reactive(req(input$dataname)) + x <- reactive({ + req(input$x, input$x %in% colnames(data()[[dataname()]])) + input$x + }) + + y <- reactive({ + req(input$y, input$y %in% colnames(data()[[dataname()]])) + input$y + }) + plot_data <- reactive({ + req(dataname(), x(), y()) + within(data(), + { + plot <- ggplot2::ggplot(dataname, ggplot2::aes(x = x, y = y)) + + ggplot2::geom_point() + }, + dataname = as.name(dataname()), + x = as.name(x()), + y = as.name(y()) + ) + }) + + plot_data_decorated_no_print <- srv_transform_teal_data( + "decorate", + data = plot_data, + transformators = decorators + ) + plot_data_decorated <- reactive( + within(req(plot_data_decorated_no_print()), expr = plot) + ) + + plot_r <- reactive({ + plot_data_decorated()[["plot"]] + }) + + output$plot <- renderPlot(plot_r()) + output$text <- renderText({ + teal.code::get_code(req(plot_data_decorated())) + }) + }) + }, + ui_args = list(decorators = decorators), + server_args = list(decorators = decorators) + ) +} +``` + +### Application + +```{r} +library(ggplot2) +app <- init( + data = teal_data(iris = iris, mtcars = mtcars), + modules = modules( + tm_decorated_plot("identity"), + tm_decorated_plot("no-ui", decorators = list(static_decorator)), + tm_decorated_plot("lang", decorators = list(static_decorator_lang)), + tm_decorated_plot("interactive", decorators = list(interactive_decorator)), + tm_decorated_plot("interactive-from lang", decorators = list(interactive_decorator_lang)), + tm_decorated_plot("from-fun", decorators = list(gg_xlab_decorator("plot"))), + tm_decorated_plot("failing", decorators = list(failing_decorator)) + ) +) + +if (interactive()) { + shinyApp(app$ui, app$server) +} +``` + +## Multiple Decorators + +### Example Module + +It is possible to pass any number of decorators (n) to a module. +The example below demonstrates how to handle a dynamic number of decorators, allowing the user to choose which decorator to apply from a list. +This makes the module more flexible and capable of accommodating various customization requirements. + +```{r} +library(ggplot2) +tm_decorated_plot <- function(label = "module", decorators = NULL) { + checkmate::assert_list(decorators, "teal_transform_module", null.ok = TRUE) + module( + label = label, + ui = function(id, decorators) { + ns <- NS(id) + div( + selectInput(ns("dataname"), label = "Select dataset", choices = NULL), + selectInput(ns("x"), label = "Select x-axis", choices = NULL), + selectInput(ns("y"), label = "Select y-axis", choices = NULL), + selectInput( + ns("decorator_choice"), + "Choose decorator", + choices = names(decorators), + selected = names(decorators)[1] + ), + div( + id = ns("decorate_wrapper"), + lapply(names(decorators), function(decorator_name) { + div( + id = ns(paste0("decorate_", decorator_name)), + ui_transform_teal_data( + ns(paste0("decorate_", decorator_name)), + transformators = decorators[[decorator_name]] + ) + ) + }) + ), + plotOutput(ns("plot")), + verbatimTextOutput(ns("text")) + ) + }, + server = function(id, data, decorators) { + moduleServer(id, function(input, output, session) { + observeEvent(data(), { + updateSelectInput(inputId = "dataname", choices = names(data())) + }) + + dataname <- reactive(req(input$dataname)) + + observeEvent(dataname(), { + updateSelectInput(inputId = "x", choices = colnames(data()[[input$dataname]])) + updateSelectInput(inputId = "y", choices = colnames(data()[[input$dataname]])) + }) + + observeEvent(input$decorator_choice, { + # Dynamically show only the selected decorator's UI + lapply(names(decorators), function(decorator_name) { + if (decorator_name == input$decorator_choice) { + shinyjs::show(paste0("decorate_", decorator_name)) + } else { + shinyjs::hide(paste0("decorate_", decorator_name)) + } + }) + }) + + x <- reactive({ + req(input$x, input$x %in% colnames(data()[[dataname()]])) + input$x + }) + + y <- reactive({ + req(input$y, input$y %in% colnames(data()[[dataname()]])) + input$y + }) + plot_data <- reactive({ + req(dataname(), x(), y()) + within(data(), + { + plot <- ggplot2::ggplot(dataname, ggplot2::aes(x = x, y = y)) + + ggplot2::geom_point() + }, + dataname = as.name(dataname()), + x = as.name(x()), + y = as.name(y()) + ) + }) + + selected_decorator <- reactive({ + req(input$decorator_choice) + input$decorator_choice + }) + + decorated_data_no_print <- srv_transform_teal_data( + sprintf("decorate_%s", selected_decorator()), + data = plot_data, + transformators = decorators[[selected_decorator()]] + ) + decorated_data <- reactive(within(req(decorated_data_no_print()), expr = plot)) + + output$plot <- renderPlot(decorated_data()[["plot"]]) + output$text <- renderText({ + req(input$decorator_choice) + teal.code::get_code(req(decorated_data())) + }) + }) + }, + ui_args = list(decorators = decorators), + server_args = list(decorators = decorators) + ) +} +``` + +By order of the decorator we will: + +1. Change the x axis title +2. Change the y axis title +3. Replace the x axis title + +```{r} +interactive_decorator_1 <- teal_transform_module( + label = "Interactive decorator 1", + ui = function(id) { + ns <- NS(id) + div( + textInput(ns("x_axis_title"), "X axis title", value = "x axis 1") + ) + }, + server = function(id, data) { + moduleServer(id, function(input, output, session) { + reactive({ + req(data()) + within(data(), + { + plot <- plot + + xlab(title) + }, + title = input$x_axis_title + ) + }) + }) + } +) + +interactive_decorator_2 <- teal_transform_module( + label = "Interactive decorator 2", + ui = function(id) { + ns <- NS(id) + div( + textInput(ns("y_axis_title"), "Y axis title", value = "y axis 1") + ) + }, + server = function(id, data) { + moduleServer(id, function(input, output, session) { + reactive({ + req(data()) + within(data(), + { + plot <- plot + + ylab(title) + }, + title = input$y_axis_title + ) + }) + }) + } +) + +interactive_decorator_3 <- teal_transform_module( + label = "Interactive decorator 3", + ui = function(id) { + ns <- NS(id) + div( + textInput(ns("x_axis_title"), "X axis title", value = "x axis 3") + ) + }, + server = function(id, data) { + moduleServer(id, function(input, output, session) { + reactive({ + req(data()) + within(data(), + { + plot <- plot + + xlab(title) + }, + title = input$x_axis_title + ) + }) + }) + } +) +``` + +### Application + +As you might have noted, the x axis title from the first decorator will be used but won't show up on the resulting plot: + +```{r} +app <- init( + data = teal_data(iris = iris, mtcars = mtcars), + modules = modules( + tm_decorated_plot( + "dynamic_decorators", + decorators = list( + decorator_1 = interactive_decorator_1, + decorator_2 = interactive_decorator_2, + decorator_3 = interactive_decorator_3 + ) + ) + ) +) + +if (interactive()) { + shinyApp(app$ui, app$server) +} +``` + + +# Modules with Multiple Outputs + +In this section, we demonstrate how to extend a teal module to handle multiple outputs and allow separate decoration for each. Specifically, the module will have two outputs: + +- a `ggplot` plot +- and a table + +We will apply independent decorators to each output. + +## Example Module with Two Outputs + +The following module generates both a scatter plot and a summary table. +Each of these outputs can be decorated independently using decorators passed to the module: + +```{r} +tm_decorated_plot_table <- function(label = "module with two outputs", decorators = list()) { + checkmate::assert_list(decorators, "teal_transform_module", null.ok = TRUE) + + module( + label = label, + ui = function(id, decorators) { + ns <- NS(id) + div( + selectInput(ns("dataname"), label = "Select dataset", choices = NULL), + selectInput(ns("x"), label = "Select x-axis", choices = NULL), + selectInput(ns("y"), label = "Select y-axis", choices = NULL), + ui_transform_teal_data(ns("decorate_plot"), transformators = decorators$plot), + ui_transform_teal_data(ns("decorate_table"), transformators = decorators$table), + plotOutput(ns("plot")), + tableOutput(ns("table")), + verbatimTextOutput(ns("text")) + ) + }, + server = function(id, data, decorators) { + moduleServer(id, function(input, output, session) { + observeEvent(data(), { + updateSelectInput(inputId = "dataname", choices = names(data())) + }) + + dataname <- reactive(req(input$dataname)) + + observeEvent(dataname(), { + updateSelectInput(inputId = "x", choices = colnames(data()[[input$dataname]])) + updateSelectInput(inputId = "y", choices = colnames(data()[[input$dataname]])) + }) + + x <- reactive({ + req(input$x, input$x %in% colnames(data()[[dataname()]])) + input$x + }) + + y <- reactive({ + req(input$y, input$y %in% colnames(data()[[dataname()]])) + input$y + }) + + # Generate plot data + plot_data <- reactive({ + req(dataname(), x(), y()) + within(data(), + { + plot <- ggplot2::ggplot(dataname, ggplot2::aes(x = xvar, y = yvar)) + + ggplot2::geom_point() + }, + dataname = as.name(dataname()), + xvar = as.name(x()), + yvar = as.name(y()) + ) + }) + + # Generate table data + table_data <- reactive({ + req(dataname()) + within(data(), + { + table_data <- data.frame(Filter(Negate(is.na), lapply(dataname, mean, na.rm = TRUE))) + }, + dataname = as.name(dataname()) + ) + }) + + # Apply decorators to plot + decorated_plot <- srv_transform_teal_data( + "decorate_plot", + data = plot_data, + transformators = decorators$plot + ) + + # Apply decorators to table + decorated_table <- srv_transform_teal_data( + "decorate_table", + data = table_data, + transformators = decorators$table + ) + + output$plot <- renderPlot(decorated_plot()[["plot"]]) + + output$table <- renderTable(decorated_table()[["table_data"]]) + + output$text <- renderText({ + plot_code <- teal.code::get_code(req(decorated_plot())) + table_code <- teal.code::get_code(req(decorated_table())) + paste("# Plot Code:", plot_code, "\n\n# Table Code:", table_code) + }) + }) + }, + ui_args = list(decorators = decorators), + server_args = list(decorators = decorators) + ) +} +``` + + +## Example Decorators + +1. **Plot Decorator**: Adds a title to the plot. + +```{r} +plot_decorator <- teal_transform_module( + label = "Decorate plot", + ui = function(id) { + ns <- NS(id) + textInput(ns("plot_title"), "Plot Title", value = "Decorated Title (editable)") + }, + server = function(id, data) { + moduleServer(id, function(input, output, session) { + reactive({ + req(data()) + within(data(), + { + plot <- plot + ggplot2::ggtitle(ptitle) + + ggplot2::theme_minimal() + + ggplot2::theme( + plot.title = element_text(face = "bold", size = 30, color = "blue") + ) + }, + ptitle = input$plot_title + ) + }) + }) + } +) +``` + + +2. **Table Decorator**: Adds row names to the summary table. + +```{r} +table_decorator <- teal_transform_module( + label = "Decorate table", + ui = function(id) shiny::tags$p("No UI needed for table decorator and could be ommited."), + server = make_teal_transform_server( + expression({ + table_data[["Added by decorator"]] <- paste0("Row ", seq_len(nrow(table_data))) + }) + ) +) +``` + + +## Application + +```{r} +app <- init( + data = teal_data(iris = iris, mtcars = mtcars), + modules = modules( + tm_decorated_plot_table( + "plot_and_table", + decorators = list( + plot = plot_decorator, + table = table_decorator + ) + ) + ) +) + +if (interactive()) { + shinyApp(app$ui, app$server) +} +```