From 68be75569f7168d9b16792d31f6bf12e89492327 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Mon, 14 Oct 2024 10:30:19 +0200 Subject: [PATCH] Delays transform modules reactivity until tab is active (#1373) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit # Pull Request Fixes #1303 ### Changes description - [x] Unifying function for delayed trigger of module and transformations - [x] Filter manager crash when clicked with an app that has module specific filters - [x] Fix bug detected when app is called with `teal_data_module` - One of my testing apps is failing (see below) - [x] Add tests ### Topics to discuss - **Functionality change**: this PR will delay the first module reactivity execution until data is pulled from `teal_data_module`
Sample app for bug ```R options( teal.log_level = "INFO", teal.show_js_log = TRUE, # teal.bs_theme = bslib::bs_theme(version = 5), shiny.bookmarkStore = "server" ) # pkgload::load_all("../teal.data") # pkgload::load_all("../teal.slice") pkgload::load_all("../teal") my_transformers <- list( teal_transform_module( label = "Keep first 6 from IRIS", ui = function(id) { ns <- NS(id) div( checkboxInput(ns("check"), label = "Toggle `head(iris)`"), ) }, server = function(id, data) { moduleServer(id, function(input, output, session) { eventReactive(input$check, { print("Check triggered") req(data()) if (input$check) { within(data(), iris <- head(iris, 6)) } else { data() } }) }) } ) ) data <- teal::teal_data_module( ui = function(id) { ns <- shiny::NS(id) shiny::tagList( shiny::tags$head( shiny::tags$style(shiny::HTML(" .teal-data-module { border: 1px solid rgba(0, 0, 0, .5); border-radius: 4px; padding: 1em; margin: .2em; } .teal-data-module .shiny-options-group { display: flex; flex-wrap: wrap; column-gap: 1em; } .teal-data-module .shiny-options-group .checkbox { margin-top: 1em; margin-bottom: 0; } ")) ), shiny::tags$h2("Data Module"), shiny::div( class = "teal-data-module", shiny::checkboxGroupInput( ns("datasets"), "Datasets", choices = c("ADSL", "ADTTE", "iris", "CO2", "miniACC"), selected = c("ADSL", "ADTTE", "iris", "CO2") ), shiny::actionButton(ns("submit"), label = "Submit") ) ) }, server = function(id, ...) { shiny::moduleServer(id, function(input, output, session) { code <- list( ADSL = expression(ADSL <- teal.data::rADSL), ADTTE = expression({ ADTTE <- teal.data::rADTTE ADTTE$CNSRL <- as.logical(ADTTE$CNSR) }), iris = expression(iris <- iris), CO2 = expression({ CO2 <- CO2 factors <- names(Filter(isTRUE, vapply(CO2, is.factor, logical(1L)))) CO2[factors] <- lapply(CO2[factors], as.character) }), miniACC = expression({ data( "miniACC", package = "MultiAssayExperiment", envir = environment(), overwrite = TRUE ) miniACC <- miniACC }) ) datasets <- reactive(input$datasets) shiny::eventReactive(input$submit, { code_to_eval <- do.call(c, code[datasets()]) data <- teal.code::eval_code(teal.data::teal_data(), code_to_eval) join_keys(data) <- default_cdisc_join_keys[datasets()] teal.data::datanames(data) <- datasets() data }) }) }, once = FALSE ) teal::init( data = data, modules = teal::modules( teal::example_module(label = "A", datanames = NULL, transformers = my_transformers), teal::example_module(label = "B", transformers = my_transformers) ), filter = teal::teal_slices( # # FilterRange teal.slice::teal_slice("ADSL", "AGE", selected = c(18L, 65L)), # # FilterExpr teal_slice( dataname = "ADSL", id = "Female adults", expr = "SEX == 'F' & AGE >= 18", title = "Female adults" ), # # FilterDatetime teal_slice( dataname = "ADTTE", varname = "ADTM", id = "Analysis DTM", selected = c("2019-03-25 07:06:18", "2020-01-22 15:03:58"), title = "Female adults" ), # # FilterDate with LSTALVDT teal_slice( dataname = "ADSL", varname = "LSTALVDT", id = "Last Alive Date", selected = c("2022-02-14", "2022-11-24"), title = "Last Alive Date" ), # FilterEmpty # FilterLogical with CNSRL teal_slice( dataname = "ADTTE", varname = "CNSRL", id = "Censored", selected = TRUE, title = "Censored" ), module_specific = FALSE, teal.slice::teal_slice("ADSL", "SEX") ), title = "yada" ) |> shiny::runApp() ```
--------- Signed-off-by: André Veríssimo <211358+averissimo@users.noreply.github.com> Co-authored-by: m7pr Co-authored-by: Marcin <133694481+m7pr@users.noreply.github.com> Co-authored-by: 27856297+dependabot-preview[bot]@users.noreply.github.com <27856297+dependabot-preview[bot]@users.noreply.github.com> Co-authored-by: Dawid Kałędkowski --- R/module_nested_tabs.R | 174 ++++++++++++------- R/teal_data_module.R | 16 ++ inst/WORDLIST | 19 +- man/call_once_when.Rd | 44 +++++ man/teal_transform_module.Rd | 6 +- tests/testthat/test-module_teal.R | 80 ++++++++- vignettes/data-transform-as-shiny-module.Rmd | 4 + 7 files changed, 262 insertions(+), 81 deletions(-) create mode 100644 man/call_once_when.Rd diff --git a/R/module_nested_tabs.R b/R/module_nested_tabs.R index cae7d9acca..c51e6138ec 100644 --- a/R/module_nested_tabs.R +++ b/R/module_nested_tabs.R @@ -214,7 +214,11 @@ srv_teal_module.teal_modules <- function(id, datasets = datasets, slices_global = slices_global, reporter = reporter, - is_active = reactive(is_active() && input$active_tab == module_id) + is_active = reactive( + is_active() && + input$active_tab == module_id && + identical(data_load_status(), "ok") + ) ) }, simplify = FALSE @@ -236,6 +240,8 @@ srv_teal_module.teal_module <- function(id, is_active = reactive(TRUE)) { logger::log_debug("srv_teal_module.teal_module initializing the module: { deparse1(modules$label) }.") moduleServer(id = id, module = function(input, output, session) { + module_out <- reactiveVal() + active_datanames <- reactive({ .resolve_module_datanames(data = data_rv(), modules = modules) }) @@ -253,77 +259,77 @@ srv_teal_module.teal_module <- function(id, # Because available_teal_slices is used in FilteredData$srv_available_slices (via srv_filter_panel) # and if it is not set, then it won't be available in the srv_filter_panel srv_module_filter_manager(modules$label, module_fd = datasets, slices_global = slices_global) - filtered_teal_data <- srv_filter_data( - "filter_panel", - datasets = datasets, - active_datanames = active_datanames, - data_rv = data_rv, - is_active = is_active - ) - is_transformer_failed <- reactiveValues() - transformed_teal_data <- srv_transform_data( - "data_transform", - data = filtered_teal_data, - transforms = modules$transformers, - modules = modules, - is_transformer_failed = is_transformer_failed - ) - any_transformer_failed <- reactive({ - any(unlist(reactiveValuesToList(is_transformer_failed))) - }) - observeEvent(any_transformer_failed(), { - if (isTRUE(any_transformer_failed())) { - shinyjs::hide("teal_module_ui") - shinyjs::hide("validate_datanames") - shinyjs::show("transformer_failure_info") - } else { - shinyjs::show("teal_module_ui") - shinyjs::show("validate_datanames") - shinyjs::hide("transformer_failure_info") - } - }) + call_once_when(is_active(), { + filtered_teal_data <- srv_filter_data( + "filter_panel", + datasets = datasets, + active_datanames = active_datanames, + data_rv = data_rv, + is_active = is_active + ) + is_transformer_failed <- reactiveValues() + transformed_teal_data <- srv_transform_data( + "data_transform", + data = filtered_teal_data, + transforms = modules$transformers, + modules = modules, + is_transformer_failed = is_transformer_failed + ) + any_transformer_failed <- reactive({ + any(unlist(reactiveValuesToList(is_transformer_failed))) + }) - module_teal_data <- reactive({ - req(inherits(transformed_teal_data(), "teal_data")) - all_teal_data <- transformed_teal_data() - module_datanames <- .resolve_module_datanames(data = all_teal_data, modules = modules) - .subset_teal_data(all_teal_data, module_datanames) - }) + observeEvent(any_transformer_failed(), { + if (isTRUE(any_transformer_failed())) { + shinyjs::hide("teal_module_ui") + shinyjs::hide("validate_datanames") + shinyjs::show("transformer_failure_info") + } else { + shinyjs::show("teal_module_ui") + shinyjs::show("validate_datanames") + shinyjs::hide("transformer_failure_info") + } + }) - srv_validate_reactive_teal_data( - "validate_datanames", - data = module_teal_data, - modules = modules - ) + module_teal_data <- reactive({ + req(inherits(transformed_teal_data(), "teal_data")) + all_teal_data <- transformed_teal_data() + module_datanames <- .resolve_module_datanames(data = all_teal_data, modules = modules) + .subset_teal_data(all_teal_data, module_datanames) + }) - summary_table <- srv_data_summary("data_summary", module_teal_data) - - # Call modules. - module_out <- reactiveVal(NULL) - if (!inherits(modules, "teal_module_previewer")) { - obs_module <- observeEvent( - # wait for module_teal_data() to be not NULL but only once: - ignoreNULL = TRUE, - once = TRUE, - eventExpr = module_teal_data(), - handlerExpr = { - module_out(.call_teal_module(modules, datasets, module_teal_data, reporter)) - } + srv_validate_reactive_teal_data( + "validate_datanames", + data = module_teal_data, + modules = modules ) - } else { - # Report previewer must be initiated on app start for report cards to be included in bookmarks. - # When previewer is delayed, cards are bookmarked only if previewer has been initiated (visited). - module_out(.call_teal_module(modules, datasets, module_teal_data, reporter)) - } - # todo: (feature request) add a ReporterCard to the reporter as an output from the teal_module - # how to determine if module returns a ReporterCard so that reportPreviewer is needed? - # Should we insertUI of the ReportPreviewer then? - # What about attr(module, "reportable") - similar to attr(module, "bookmarkable") - if ("report" %in% names(module_out)) { - # (reactively) add card to the reporter - } + summary_table <- srv_data_summary("data_summary", module_teal_data) + + # Call modules. + if (!inherits(modules, "teal_module_previewer")) { + obs_module <- call_once_when( + !is.null(module_teal_data()), + ignoreNULL = TRUE, + handlerExpr = { + module_out(.call_teal_module(modules, datasets, module_teal_data, reporter)) + } + ) + } else { + # Report previewer must be initiated on app start for report cards to be included in bookmarks. + # When previewer is delayed, cards are bookmarked only if previewer has been initiated (visited). + module_out(.call_teal_module(modules, datasets, module_teal_data, reporter)) + } + + # todo: (feature request) add a ReporterCard to the reporter as an output from the teal_module + # how to determine if module returns a ReporterCard so that reportPreviewer is needed? + # Should we insertUI of the ReportPreviewer then? + # What about attr(module, "reportable") - similar to attr(module, "bookmarkable") + if ("report" %in% names(module_out)) { + # (reactively) add card to the reporter + } + }) module_out }) @@ -368,3 +374,39 @@ srv_teal_module.teal_module <- function(id, ) } } + +#' Calls expression when condition is met +#' +#' Function postpones `handlerExpr` to the moment when `eventExpr` (condition) returns `TRUE`, +#' otherwise nothing happens. +#' @param eventExpr A (quoted or unquoted) logical expression that represents the event; +#' this can be a simple reactive value like input$click, a call to a reactive expression +#' like dataset(), or even a complex expression inside curly braces. +#' @param ... additional arguments passed to `observeEvent` with the exception of `eventExpr` that is not allowed. +#' @inheritParams shiny::observeEvent +#' +#' @return An observer. +#' +#' @keywords internal +call_once_when <- function(eventExpr, # nolint: object_name. + handlerExpr, # nolint: object_name. + event.env = parent.frame(), # nolint: object_name. + handler.env = parent.frame(), # nolint: object_name. + ...) { + event_quo <- rlang::new_quosure(substitute(eventExpr), env = event.env) + handler_quo <- rlang::new_quosure(substitute(handlerExpr), env = handler.env) + + # When `condExpr` is TRUE, then `handlerExpr` is evaluated once. + activator <- reactive({ + if (isTRUE(rlang::eval_tidy(event_quo))) { + TRUE + } + }) + + observeEvent( + eventExpr = activator(), + once = TRUE, + handlerExpr = rlang::eval_tidy(handler_quo), + ... + ) +} diff --git a/R/teal_data_module.R b/R/teal_data_module.R index 8051b604b4..5017be1432 100644 --- a/R/teal_data_module.R +++ b/R/teal_data_module.R @@ -104,6 +104,10 @@ teal_data_module <- function(ui, server, label = "data module", once = TRUE) { #' `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 the module. The #' filter panel will only display filters for specified `datanames`. The keyword `"all"` will show @@ -149,6 +153,18 @@ teal_transform_module <- function(ui = function(id) NULL, 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), diff --git a/inst/WORDLIST b/inst/WORDLIST index cf9153ad3f..5e1ef7cab6 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -1,28 +1,29 @@ Biomarker -CDISC -Forkers -Hoffmann -MAEs -ORCID -Reproducibility -TLG -UI -UX bookmarkable +CDISC cloneable customizable favicon favicons +Forkers funder +Hoffmann lockfile +MAEs omics +ORCID pre programmatically +quosure reactively repo +Reproducibility reproducibility summarization tabset themer theming +TLG +UI uncheck +UX diff --git a/man/call_once_when.Rd b/man/call_once_when.Rd new file mode 100644 index 0000000000..fbc196a4f0 --- /dev/null +++ b/man/call_once_when.Rd @@ -0,0 +1,44 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/module_nested_tabs.R +\name{call_once_when} +\alias{call_once_when} +\title{Calls expression when condition is met} +\usage{ +call_once_when( + eventExpr, + handlerExpr, + event.env = parent.frame(), + handler.env = parent.frame(), + ... +) +} +\arguments{ +\item{eventExpr}{A (quoted or unquoted) logical expression that represents the event; +this can be a simple reactive value like input$click, a call to a reactive expression +like dataset(), or even a complex expression inside curly braces.} + +\item{handlerExpr}{The expression to call whenever \code{eventExpr} is +invalidated. This should be a side-effect-producing action (the return +value will be ignored). It will be executed within an \code{\link[shiny:isolate]{isolate()}} +scope.} + +\item{event.env}{The parent environment for the reactive expression. By default, +this is the calling environment, the same as when defining an ordinary +non-reactive expression. If \code{eventExpr} is a quosure and \code{event.quoted} is \code{TRUE}, +then \code{event.env} is ignored.} + +\item{handler.env}{The parent environment for the reactive expression. By default, +this is the calling environment, the same as when defining an ordinary +non-reactive expression. If \code{handlerExpr} is a quosure and \code{handler.quoted} is \code{TRUE}, +then \code{handler.env} is ignored.} + +\item{...}{additional arguments passed to \code{observeEvent} with the exception of \code{eventExpr} that is not allowed.} +} +\value{ +An observer. +} +\description{ +Function postpones \code{handlerExpr} to the moment when \code{eventExpr} (condition) returns \code{TRUE}, +otherwise nothing happens. +} +\keyword{internal} diff --git a/man/teal_transform_module.Rd b/man/teal_transform_module.Rd index 0f424b329f..e64e0ca25f 100644 --- a/man/teal_transform_module.Rd +++ b/man/teal_transform_module.Rd @@ -18,7 +18,11 @@ teal_transform_module( \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 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{label}{(\code{character(1)}) Label of the module.} diff --git a/tests/testthat/test-module_teal.R b/tests/testthat/test-module_teal.R index e863a1325f..e18c975e13 100644 --- a/tests/testthat/test-module_teal.R +++ b/tests/testthat/test-module_teal.R @@ -302,6 +302,36 @@ testthat::describe("srv_teal teal_modules", { ) }) + testthat::it("are called only after teal_data_module is resolved", { + shiny::testServer( + app = srv_teal, + args = list( + id = "test", + data = teal_data_module( + ui = function(id) actionButton("submit", "click me"), + server = function(id) { + moduleServer(id, function(input, output, session) { + eventReactive(input$submit, teal_data(iris = iris)) + }) + } + ), + modules = modules( + module("module_1", server = function(id, data) 101L) + ) + ), + expr = { + session$setInputs(`teal_modules-active_tab` = "module_1") + session$flushReact() + testthat::expect_null(modules_output$module_1()) + + + session$setInputs("data-teal_data_module-submit" = "1") + session$flushReact() + testthat::expect_identical(modules_output$module_1(), 101L) + } + ) + }) + testthat::it("are called with data argument being `teal_data`", { shiny::testServer( app = srv_teal, @@ -1587,8 +1617,8 @@ testthat::describe("srv_teal teal_module(s) transformer", { ) }) - testthat::it("fails when transformer doesn't return reactive", { - testthat::expect_error( + testthat::it("throws warning when transformer return reactive.event", { + testthat::expect_warning( testServer( app = srv_teal, args = list( @@ -1599,14 +1629,54 @@ testthat::describe("srv_teal teal_module(s) transformer", { server = function(id, data) data, transformers = list( teal_transform_module( - ui = function(id) NULL, - server = function(id, data) "whatever" + ui = function(id) textInput("a", "an input"), + server = function(id, data) eventReactive(input$a, data()) ) ) ) ) ), - expr = {} + expr = { + session$setInputs("teal_modules-active_tab" = "module") + session$flushReact() + } + ), + "Using eventReactive in teal_transform module server code should be avoided" + ) + }) + + testthat::it("fails when transformer doesn't return reactive", { + testthat::expect_warning( + # error decorator is mocked to avoid showing the trace error during the + # test. + # This tests works without the mocking, but it's more verbose. + testthat::with_mocked_bindings( + testServer( + app = srv_teal, + args = list( + id = "test", + data = teal.data::teal_data(iris = iris), + modules = modules( + module( + server = function(id, data) data, + transformers = list( + teal_transform_module( + ui = function(id) NULL, + server = function(id, data) "whatever" + ) + ) + ) + ) + ), + expr = { + session$setInputs("teal_modules-active_tab" = "module") + session$flushReact() + } + ), + decorate_err_msg = function(x, ...) { + testthat::expect_error(x, "Must be a reactive") + warning(tryCatch(x, error = function(e) e$message)) + }, ), "Must be a reactive" ) diff --git a/vignettes/data-transform-as-shiny-module.Rmd b/vignettes/data-transform-as-shiny-module.Rmd index 306dd3217c..854b507b66 100644 --- a/vignettes/data-transform-as-shiny-module.Rmd +++ b/vignettes/data-transform-as-shiny-module.Rmd @@ -94,6 +94,10 @@ if (interactive()) { } ``` +_Note_: It is recommended to return `reactive()` with `teal_data()` in `server` code of a `teal_transform_module` as this is more robust for maintaining the reactivity of Shiny. +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 Note that we can add multiple `teal` transformers by including `teal_transform_module` in a list.