Implement `teal_transform_module`

[averissimo]

Pull Request

Fixes #1228

Changes description

• Adds teal_transform_module with ui and server
• Allow module developer to place UI by default on teal interface or within module
  • Using transformers formal in ui function to flag it (present: default, not present: module developer)
  • Currently being placed below filter panel
• Adds error message when "transformer" operation creates a qenv.error

note: Currently, data is manipulated after filtering (hence new datasets won't appear on Filter panel)

Example DDL

#### Notes on DDL - Contains 2 modules with the same transformer list 1. module `UI` function doesn't have `transformer` formal, and UI must be included by module developer with the correct namespace 2. default location under filter panel - First transform is a complex one that generates `qenv.errors` when: 1. No datasets are selected for merge 2. Trying to merge incompatible datasets (ex. ADSL and iris) - Datasets is not populated until `data()` is valid (`datanames(data())` returns NULL) ```r options( teal.log_level = "ERROR", teal.show_js_log = TRUE, # teal.bs_theme = bslib::bs_theme(version = 5), shiny.bookmarkStore = "server" ) pkgload::load_all("../teal") # Tranformer definition (reused in 2 modules) --------------------------------- my_transformers <- list( teal_data_module( label = "Dummy", ui = function(id) div("(does nothing)"), server = function(id, data) { moduleServer(id, function(input, output, session) data) } ), teal_data_module( label = "Merge ANL", ui = function(id) { ns <- NS(id) tagList( div("UI for merge transform"), teal.widgets::optionalSelectInput(ns("merge_a"), "Merge A", choices = NULL), teal.widgets::optionalSelectInput(ns("merge_b"), "Merge B", choices = NULL) ) }, server = function(id, data) { checkmate::assert_class(data, "reactive") moduleServer(id, function(input, output, session) { iv <- shinyvalidate::InputValidator$new() iv$add_rule("merge_a", shinyvalidate::sv_required("Please select dataset A")) iv$add_rule("merge_b", shinyvalidate::sv_required("Please select dataset B")) iv$enable() reactive_datanames <- reactive({ req(data()) teal.data::datanames(data()) }) observeEvent(reactive_datanames(), { selected_a <- isolate(input$merge_a) if (identical(selected_a, "")) selected_a <- restoreInput(session$ns("merge_a"), NULL) teal.widgets::updateOptionalSelectInput( session = session, inputId = "merge_a", choices = reactive_datanames(), selected = restoreInput(session$ns("merge_a"), selected_a) ) selected_b <- isolate(input$merge_b) if (identical(selected_b, "")) selected <- restoreInput(session$ns("merge_b"), NULL) teal.widgets::updateOptionalSelectInput( session = session, inputId = "merge_b", choices = reactive_datanames(), selected = restoreInput(session$ns("merge_b"), selected_b) ) }) merge_a <- reactive(input$merge_a) merge_b <- reactive(input$merge_b) reactive({ new_data <- within( data(), ANL <- dplyr::left_join(merge_a, merge_b), merge_a = tryCatch(as.name(merge_a()), error = function(e) as.name("DatasetA")), merge_b = tryCatch(as.name(merge_b()), error = function(e) as.name("DatasetA")) ) teal.data::datanames(new_data) <- c(teal.data::datanames(new_data), "ANL") new_data }) }) } ), teal_data_module( label = "Click the button", ui = function(id) { tagList( tags$p("Keeps only first 6 rows of CO2"), tags$p("(this module uses eventReactive and is in error state until clicked"), actionButton(NS(id, "button"), "Click me!") ) }, server = function(id, data) { moduleServer(id, function(input, output, session) { eventReactive(input$button, { shinyjs::disable(id = "button") within(data(), CO2 <- head(CO2)) }) }) } ), teal_data_module( label = "Keep first half of iris?", ui = function(id) actionButton(NS(id, "button"), "Click to apply/remove"), server = function(id, data) { moduleServer(id, function(input, output, session) { reactive({ if (input$button %% 2 == 0) { data() # do nothing } else { within(data(), iris <- head(iris, n = nrow(iris) / 2)) } }) }) } ), teal_data_module( label = "Keep first 6 from ADTTE", ui = function(id) div("Some UI for transform 2"), server = function(id, data) { moduleServer(id, function(input, output, session) reactive({ within(data(), ADTTE <- head(ADTTE)) })) } ) ) # Transformer modules definition ---------------------------------------------- # Reuses previous one, but places UI in default location ---------------------- example_module_encoding <- function(label = "example teal module (on encoding)", datanames = "all", transformers = list()) { mod <- example_module(label, datanames, transformers) mod$ui <- function(id) { ns <- NS(id) teal.widgets::standard_layout( output = verbatimTextOutput(ns("text")), encoding = tags$div( ui_teal_data_modules(NS(gsub("-module$", "", id), "data_transform"), transformers), selectInput(ns("dataname"), "Choose a dataset", choices = NULL), teal.widgets::verbatim_popup_ui(ns("rcode"), "Show R code") ) ) } attr(mod$transformers, "custom_ui") <- TRUE mod } # ----------------------------------------------------------------------------- data <- teal_data_module( ui = function(id) { ns <- NS(id) tagList( textInput(ns("username"), label = "Username"), passwordInput(ns("password"), label = "Password"), actionButton(ns("submit"), label = "Submit") ) }, server = function(id, ...) { moduleServer(id, function(input, output, session) { eventReactive(input$submit, { data <- teal_data() |> within( { logger::log_trace("Loading data") ADSL <- teal.data::rADSL ADTTE <- teal.data::rADTTE iris <- iris CO2 <- CO2 factors <- names(Filter(isTRUE, vapply(CO2, is.factor, logical(1L)))) CO2[factors] <- lapply(CO2[factors], as.character) }, username = input$username, password = input$password ) join_keys(data) <- default_cdisc_join_keys[c("ADSL", "ADTTE")] teal.data::datanames(data) <- c("ADSL", "ADTTE", "iris", "CO2") data }) }) } ) init( data = data, modules = list( example_module( label = "example teal module (datanames = subset and ANL)", transformers = my_transformers, datanames = c("ADSL", "ADTTE", "ANL") ), example_module_encoding( transformers = my_transformers, datanames = c("ADSL", "ADTTE", "ANL") ), example_module( label = "example teal module (datanames = all)", transformers = my_transformers ) ), filter = teal_slices( teal_slice("ADSL", "SEX"), teal_slice("ADSL", "AGE", selected = c(18L, 65L)) ) ) |> runApp() ```

Example DDL 2

```r options( teal.log_level = "FATAL", teal.show_js_log = TRUE, # teal.bs_theme = bslib::bs_theme(version = 5), shiny.bookmarkStore = "server" ) pkgload::load_all("../teal") # Tranformer definition (reused in 2 modules) --------------------------------- my_transformers <- list( teal_data_module( label = "reactive ADSL", ui = function(id) { ns <- NS(id) tagList( tags$p("(this module uses eventReactive and is in error state until clicked"), actionButton(ns("btn"), "Reload data") ) }, server = function(id, data) { moduleServer(id, function(input, output, session) { eventReactive(input$btn, { data() }) }) } ), teal_data_module( label = "Keep first N from IRIS", ui = function(id) { ns <- NS(id) div( span("Some UI for transform (1)"), textInput(ns("obs"), label = "Number of rows", value = 6) ) }, server = function(id, data) { moduleServer(id, function(input, output, session) { reactive({ req(data()) obs <- as.numeric(input$obs) if (!is.finite(obs)) stop("NOT NUMERIC.") within(data(), iris <- head(iris, n), n = as.numeric(input$obs)) }) }) } ), teal_data_module( label = "Keep first 6 from ADTTE", ui = function(id) div("Some UI for transform 2"), server = function(id, data) { moduleServer(id, function(input, output, session) { reactive({ req(data()) within(data(), ADTTE <- head(ADTTE)) }) }) } ) ) # Transformer modules definition ---------------------------------------------- # Reuses previous one, but places UI in default location ---------------------- example_module_encoding <- function(label = "example teal module (on encoding)", datanames = "all", transformers = list()) { mod <- example_module(label, datanames, transformers) mod$ui <- function(id) { ns <- NS(id) teal.widgets::standard_layout( output = verbatimTextOutput(ns("text")), encoding = tags$div( ui_teal_data_modules(NS(gsub("-module$", "", id), "data_transform"), transformers), selectInput(ns("dataname"), "Choose a dataset", choices = NULL), teal.widgets::verbatim_popup_ui(ns("rcode"), "Show R code") ) ) } attr(mod$transformers, "custom_ui") <- TRUE mod } # ----------------------------------------------------------------------------- data <- teal_data_module( ui = function(id) { ns <- NS(id) tagList( numericInput(ns("obs"), "Number of observations to show", 1000), actionButton(ns("submit"), label = "Submit") ) }, server = function(id, ...) { moduleServer(id, function(input, output, session) { eventReactive(input$submit, { data <- teal_data() |> within( { logger::log_trace("Loading data") ADSL <- head(teal.data::rADSL, n = n) ADTTE <- teal.data::rADTTE iris <- iris CO2 <- CO2 factors <- names(Filter(isTRUE, vapply(CO2, is.factor, logical(1L)))) CO2[factors] <- lapply(CO2[factors], as.character) }, n = as.numeric(input$obs) ) join_keys(data) <- default_cdisc_join_keys[c("ADSL", "ADTTE")] teal.data::datanames(data) <- c("ADSL", "ADTTE", "iris", "CO2") data }) }) } ) init( data = data, modules = list( example_module(transformers = my_transformers), example_module_encoding(transformers = my_transformers) # example_module() ), filter = teal_slices( teal_slice("ADSL", "SEX"), teal_slice("ADSL", "AGE", selected = c(18L, 65L)) ) ) |> runApp() ```

[averissimo]

Some screenshots:

1. Default location (below filter panel)
2. Transform panels placed "manually" in the encoding panel
3. R Code with all transformations in order
   • When ADSL and ADTTE are chosen

[averissimo]

Updated with some styling and collapsible features

[averissimo]

~An assertion was missing in the example_module_transform$server on the ddl code above (checkmate::assert_class(isolate(data()), "teal_data"))~ edit: this will break it in a different way.

Duplicate error message will appear downstream in teal transform modules as well as in the summary.

I was avoiding this by detecting if the error was already being shown. Maybe we can do something similar:

• Detect on transform modules if qenv.error is already present in teal_data argument
• Data summary:
  1. Repeat error
  2. Create special error that will refer to other part of app
  3. Try to fallback to the filtered data (that srv doesn't know about it though)

[averissimo]

API change: moved transformers from {ui,srv}_arguments to module parameter.

Added a custom_ui attribute detection for advanced usage when app developer wants to determine where to put the UI. Keep compatibility, but this can be completely removed.

[donyunardi]

The ANL created during transform is not being retained when user perform filtering activities (i.e. add or remove filter) after transformation.

https://github.com/user-attachments/assets/e44db240-dcbc-4161-901f-7e12c7dfdbc7

As you can see, everytime I tried to add a filter to ADSL, hoping that I can see the update on my ANL, the ANL data is dropped and user is forced to perform the merge again via the UI.

I think the expected behavior should be the transform module is automatically being run during my filter so that user don't have to merge it again.

Any idea on how we can make this experience better? Should there be an indicator in the transform module that can tell teal whether to run the transform module (or not) during filtering activity?

[averissimo]

Thanks @donyunardi for finding this out :100: The transform module was not well defined and I've updated the example to reflect this.

Full context: The transformer module is reactive to the datanames and bookmarkable, so after filtering the data it re-executes the server function of the transform, replacing the previous selection with the default value.

The code below keeps the previous selection while still being bookmarkable.

          selected_a <- isolate(input$merge_a)
          if (identical(selected_a, "")) selected_a <- restoreInput(session$ns("merge_a"), NULL)
          teal.widgets::updateOptionalSelectInput(
            session = session,
            inputId = "merge_a",
            choices = reactive_datanames(),
            selected = restoreInput(session$ns("merge_a"), selected_a)
          )