diff --git a/DESCRIPTION b/DESCRIPTION index 3b1f5bc0ed..13ef344a0d 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,8 +1,8 @@ Type: Package Package: teal Title: Exploratory Web Apps for Analyzing Clinical Trials Data -Version: 0.15.2.9082 -Date: 2024-11-08 +Version: 0.15.2.9085 +Date: 2024-11-11 Authors@R: c( person("Dawid", "Kaledkowski", , "dawid.kaledkowski@roche.com", role = c("aut", "cre"), comment = c(ORCID = "0000-0001-9533-457X")), @@ -37,7 +37,7 @@ BugReports: https://github.com/insightsengineering/teal/issues Depends: R (>= 4.0), shiny (>= 1.8.1), - teal.data (>= 0.6.0.9015), + teal.data (>= 0.6.0.9017), teal.slice (>= 0.5.1.9009) Imports: checkmate (>= 2.1.0), @@ -49,7 +49,7 @@ Imports: rlang (>= 1.0.0), shinyjs, stats, - teal.code (>= 0.5.0.9012), + teal.code (>= 0.5.0.9015), teal.logger (>= 0.2.0), teal.reporter (>= 0.3.1.9004), teal.widgets (>= 0.4.0), diff --git a/NEWS.md b/NEWS.md index 02257c6e82..1401db5eae 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,4 @@ -# teal 0.15.2.9082 +# teal 0.15.2.9085 ### New features diff --git a/R/module_nested_tabs.R b/R/module_nested_tabs.R index 588227498a..82f525cc18 100644 --- a/R/module_nested_tabs.R +++ b/R/module_nested_tabs.R @@ -294,7 +294,7 @@ srv_teal_module.teal_module <- function(id, 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) + all_teal_data[c(module_datanames, ".raw_data")] }) srv_validate_reactive_teal_data( diff --git a/R/teal_data_utils.R b/R/teal_data_utils.R index f5244c5736..2b5b51c8b6 100644 --- a/R/teal_data_utils.R +++ b/R/teal_data_utils.R @@ -11,7 +11,6 @@ #' @param data (`teal_data`) #' @param code (`character`) code to append to the object's code slot. #' @param objects (`list`) objects to append to object's environment. -#' @param datanames (`character`) names of the datasets #' @return modified `teal_data` #' @keywords internal #' @name teal_data_utilities @@ -20,10 +19,7 @@ NULL #' @rdname teal_data_utilities .append_evaluated_code <- function(data, code) { checkmate::assert_class(data, "teal_data") - data@code <- c(data@code, code) - data@id <- c(data@id, max(data@id) + 1L + seq_along(code)) - data@messages <- c(data@messages, rep("", length(code))) - data@warnings <- c(data@warnings, rep("", length(code))) + data@code <- c(data@code, code2list(code)) methods::validObject(data) data } @@ -37,27 +33,3 @@ NULL data@.xData <- new_env data } - -#' @rdname teal_data_utilities -.subset_teal_data <- function(data, datanames) { - checkmate::assert_class(data, "teal_data") - checkmate::assert_class(datanames, "character") - datanames_corrected <- intersect(datanames, names(data)) - datanames_corrected_with_raw <- c(datanames_corrected, ".raw_data") - if (!length(datanames_corrected)) { - return(teal_data()) - } - - new_data <- do.call( - teal.data::teal_data, - args = c( - mget(x = datanames_corrected_with_raw, envir = as.environment(data)), - list( - code = teal.code::get_code(data, names = datanames_corrected_with_raw), - join_keys = teal.data::join_keys(data)[datanames_corrected] - ) - ) - ) - new_data@verified <- data@verified - new_data -} diff --git a/R/zzz.R b/R/zzz.R index a991d041f2..62c8029561 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -37,3 +37,4 @@ RcodeBlock <- getFromNamespace("RcodeBlock", "teal.reporter") # nolint: object_n # Use non-exported function(s) from teal.code # This one is here because lang2calls should not be exported from teal.code lang2calls <- getFromNamespace("lang2calls", "teal.code") +code2list <- getFromNamespace("code2list", "teal.data") diff --git a/inst/WORDLIST b/inst/WORDLIST index 77ac78fdfb..41727a7f93 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -5,6 +5,7 @@ Hoffmann MAEs ORCID Reproducibility +Shiny's TLG UI UX @@ -16,6 +17,7 @@ favicon favicons funder lockfile +modularized omics pre programmatically diff --git a/man/teal_data_utilities.Rd b/man/teal_data_utilities.Rd index f7943f3910..0fdcaa6653 100644 --- a/man/teal_data_utilities.Rd +++ b/man/teal_data_utilities.Rd @@ -4,14 +4,11 @@ \alias{teal_data_utilities} \alias{.append_evaluated_code} \alias{.append_modified_data} -\alias{.subset_teal_data} \title{\code{teal_data} utils} \usage{ .append_evaluated_code(data, code) .append_modified_data(data, objects) - -.subset_teal_data(data, datanames) } \arguments{ \item{data}{(\code{teal_data})} @@ -19,8 +16,6 @@ \item{code}{(\code{character}) code to append to the object's code slot.} \item{objects}{(\code{list}) objects to append to object's environment.} - -\item{datanames}{(\code{character}) names of the datasets} } \value{ modified \code{teal_data} diff --git a/tests/testthat/test-module_teal.R b/tests/testthat/test-module_teal.R index dd60c2c619..2e91a13f57 100644 --- a/tests/testthat/test-module_teal.R +++ b/tests/testthat/test-module_teal.R @@ -1413,10 +1413,10 @@ testthat::describe("srv_teal filters", { c( "iris <- iris", "mtcars <- mtcars", - sprintf('stopifnot(rlang::hash(iris) == "%s")', rlang::hash(iris)), - sprintf('stopifnot(rlang::hash(mtcars) == "%s")', rlang::hash(mtcars)), + 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)", + "lockEnvironment(.raw_data) # @linksto .raw_data", "mtcars <- dplyr::filter(mtcars, cyl == 4)" ), collapse = "\n" @@ -1591,10 +1591,10 @@ testthat::describe("srv_teal teal_module(s) transformer", { expected_code <- paste(collapse = "\n", c( "iris <- iris", "mtcars <- mtcars", - sprintf('stopifnot(rlang::hash(iris) == "%s")', rlang::hash(iris)), - sprintf('stopifnot(rlang::hash(mtcars) == "%s")', rlang::hash(mtcars)), + 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)", + "lockEnvironment(.raw_data) # @linksto .raw_data", 'iris <- dplyr::filter(iris, Species == "versicolor")', "mtcars <- dplyr::filter(mtcars, cyl == 6)", "iris <- head(iris, n = 6)", @@ -1637,10 +1637,10 @@ testthat::describe("srv_teal teal_module(s) transformer", { expected_code <- paste(collapse = "\n", c( "iris <- iris", "mtcars <- mtcars", - sprintf('stopifnot(rlang::hash(iris) == "%s")', rlang::hash(iris)), - sprintf('stopifnot(rlang::hash(mtcars) == "%s")', rlang::hash(mtcars)), + 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)", + "lockEnvironment(.raw_data) # @linksto .raw_data", "mtcars <- dplyr::filter(mtcars, cyl == 4)", "iris <- head(iris, n = 6)", "mtcars <- head(mtcars, n = 6)" @@ -2445,7 +2445,7 @@ testthat::describe("Datanames with special symbols", { } ), modules = modules( - module("module_1", server = function(id, data) data, , datanames = c("iris")) + module("module_1", server = function(id, data) data, datanames = c("iris")) ), filter = teal_slices( module_specific = TRUE @@ -2483,7 +2483,7 @@ testthat::describe("teal.data code with a function defined", { } })), modules = modules(module("module_1", server = function(id, data) data)) - ), , + ), expr = { session$setInputs("teal_modules-active_tab" = "module_1") session$flushReact() @@ -2545,9 +2545,9 @@ testthat::describe("teal.data code with a function defined", { "y <- x + 1", "y + 3", "}", - sprintf("stopifnot(rlang::hash(deparse1(fun)) == \"%s\")", local_env$hash), + sprintf("stopifnot(rlang::hash(deparse1(fun)) == \"%s\") # @linksto fun", local_env$hash), ".raw_data <- list2env(list(fun = fun))", - "lockEnvironment(.raw_data)" + "lockEnvironment(.raw_data) # @linksto .raw_data" ) ) } diff --git a/tests/testthat/test-shinytest2-show-rcode.R b/tests/testthat/test-shinytest2-show-rcode.R index 20901cd270..a7504573f0 100644 --- a/tests/testthat/test-shinytest2-show-rcode.R +++ b/tests/testthat/test-shinytest2-show-rcode.R @@ -42,16 +42,15 @@ testthat::test_that("e2e: teal app initializes with Show R Code modal", { ) # Check R code output. - testthat::expect_identical( - app$get_text(app$active_module_element("rcode-verbatim_content")), - paste( + testthat::expect_setequal( + strsplit(app$get_text(app$active_module_element("rcode-verbatim_content")), "\n")[[1]], + c( "iris <- iris", "mtcars <- mtcars", - sprintf('stopifnot(rlang::hash(iris) == "%s")', rlang::hash(iris)), - sprintf('stopifnot(rlang::hash(mtcars) == "%s")', rlang::hash(mtcars)), + 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)", - sep = "\n" + "lockEnvironment(.raw_data) # @linksto .raw_data" ) ) diff --git a/vignettes/creating-custom-modules.Rmd b/vignettes/creating-custom-modules.Rmd index e41c59e136..5a1f66e04b 100644 --- a/vignettes/creating-custom-modules.Rmd +++ b/vignettes/creating-custom-modules.Rmd @@ -12,173 +12,254 @@ vignette: > ## Introduction -The `teal` framework provides a large catalog of plug-in-ready analysis modules to be incorporated into `teal` applications. -However, it is also possible to create your own modules using the `module` function. +The `teal` framework provides a large catalog of plug-in-ready analysis modules that can be incorporated into `teal` applications. +However, it is also possible to create your own modules using the module function, which leverages Shiny modules. +Each custom teal module is built as a Shiny module, combining Shiny's reactive capabilities with modularized UI and server logic to encapsulate functionality. +This design enables a structured and reusable approach to creating interactive components that integrate seamlessly within the teal ecosystem. + +In this guide, we will use the simple histogram below as an example, and demonstrate how to convert this histogram function into a robust `teal` module step-by-step: + +```r +my_plot <- hist( + dataset[[vars]], + las = 1, + main = paste("Histogram of", vars), + xlab = vars, + col = "lightblue", + border = "black" +) +``` + +This module will allow users to dynamically select datasets and variables to create histograms within a `teal` application. +We will cover best practices, including: + +* Setting up dynamic inputs. +* Structuring server logic. +* Using the `teal_data` object to ensure reactivity and reproducibility. + +## Understanding the Inputs and Requirements + +When developing a custom `teal` module for visualizations, we will first identify the primary inputs that users will interact with: + +* **Dataset Input** (`dataset`): Allows users to select which dataset to explore. +* **Variable Input** (`vars`): Allows users to choose a specific numeric variable from the chosen dataset, ensuring only appropriate columns are available for plotting. + +These inputs are dynamically populated based on the available datasets and variables in the `teal_data` object, which we will cover later. + +## Setting Up the `teal` Module UI + +The UI function defines the controls and display area for the histogram. +For this module, we will use: + +- **`selectInput` for Dataset**: Enables users to select a dataset from the list of available datasets. +- **`selectInput` for Variable**: Allows users to choose a numeric variable from the chosen dataset, dynamically filtering out any non-numeric columns. +- **`plotOutput` for Histogram**: Displays the histogram once both dataset and variable inputs are selected. +- **`verbatimTextOutput` for Code**: Automatically displays code that generated the plot based on user input. + +Here’s the code for the `histogram_module_ui` function: + +```r +# UI function for the custom histogram module +histogram_module_ui <- function(id) { + ns <- shiny::NS(id) + shiny::tagList( + shiny::selectInput(ns("dataset"), "Select Dataset", choices = NULL), + shiny::selectInput(ns("variable"), "Select Variable", choices = NULL), + shiny::plotOutput(ns("histogram_plot")), + shiny::verbatimTextOutput(ns("plot_code")) # To display the reactive plot code + ) +} +``` + +## Setting Up the `teal` Module Server + +The server function is where the main logic of a `teal` module is handled. +For our histogram module, the server function will handle user interactions and manage the reactive `teal_data` object, which allows the module to dynamically respond to user inputs. -## Components of a module +### Passing the `data` Argument to the Server Function -### UI function +To begin, it’s essential to include the `data` argument in the server function definition. -This function contains the UI required for the module. -It should be a function with at least the argument `id`. -See the server section below for more details. +This `data` argument holds the reactive `teal_data` object, which contains your datasets and any filters applied. By including `data`, we can ensure: -### Server function +- The server function receives a reactive version of `teal_data`, allowing it to automatically respond to changes. +- The server can access the filtered datasets directly. -This function contains the `shiny` server logic for the module and should be of the form: +The correct function definition for the server function is: -```{r, eval=FALSE} -function( - id, - data, # optional; use if module needs access to application data - filter_panel_api, # optional; use if module needs access to filter panel; see teal.slice - reporter, # optional; use if module supports reporting; see reporting vignette - ...) { +```r +histogram_module_server <- function(id, data) { moduleServer(id, function(input, output, session) { - # module code here + # Server logic goes here }) } ``` -The data that arrives in the module is a `teal_data` object, the data container used throughout the `teal` application. -`teal_data` is passed to the `init` function when building the application and, after filtering by the filter panel, it is passed to modules, wrapped in a reactive expression. -The `teal_data` class allows modules to track the `R` code that they execute so that module outputs can be reproduced. -See the `teal.data` package for a [detailed explanation](https://insightsengineering.github.io/teal.data/latest-tag/articles/teal-data-reproducibility.html). +If you need a refresher on the `teal_data` object, please visit the [teal.data package documentation](https://insightsengineering.github.io/teal.data/latest-tag/articles/teal-data.html). -## Example modules +### Understanding `teal_data` as a Reactive Object in Server Logic -### Viewing data +When used in the server logic of a `teal` module, the `teal_data` object becomes a **reactive data container**. +This means that to access its contents, you need to call it like a function, using parentheses: `data()`. -Here is a minimal module that allows the user to select and view one dataset at a time. -By default, filtering is enabled for all datasets. -Note that dataset choices are specified by the `datanames` property of the `teal_data` container. +This syntax triggers reactivity, ensuring that the data within `teal_data` stays up-to-date with any filters or changes applied elsewhere in the application. -```{r, message=FALSE} -library(teal) +> **Note**: The `teal_data` object behaves as a reactive data container only when used within the server logic. If accessed outside of the server, it will not be reactive. -my_module <- function(label = "example teal module") { - checkmate::assert_string(label) +### Using `names()` to Access Dataset Names in `teal_data` object - module( - label = label, - server = function(id, data) { - moduleServer(id, function(input, output, session) { - updateSelectInput(session, "dataname", choices = isolate(names(data()))) - output$dataset <- renderPrint({ - req(input$dataname) - data()[[input$dataname]] - }) - }) - }, - ui = function(id) { - ns <- NS(id) - sidebarLayout( - sidebarPanel(selectInput(ns("dataname"), "Choose a dataset", choices = NULL)), - mainPanel(verbatimTextOutput(ns("dataset"))) - ) - } - ) -} +The `teal_data` object can contain multiple datasets. To retrieve the names of these datasets, use the `names()` function: + +```r +names(data()) ``` -### Interacting with data and viewing code +This will return a character vector of the dataset names contained in `teal_data`. +You can then use these names to dynamically populate input controls, like a dataset selection drop-down. -The example below allows the user to interact with the data to create a simple visualization. -In addition, it prints the code that can be used to reproduce that visualization. +### Accessing Specific Datasets with Double Brackets (`[[ ]])` -```{r} -library(teal) +To access an individual dataset from `teal_data`, use double brackets (`[[ ]]`) along with the dataset name. This allows you to extract the specific dataset as a data frame: -# ui function for the module -# allows for selecting dataset and one of its numeric variables -ui_histogram_example <- function(id) { - ns <- NS(id) - sidebarLayout( - sidebarPanel( - selectInput(ns("datasets"), "select dataset", choices = NULL), - selectInput(ns("numerics"), "select numeric variable", choices = NULL) - ), - mainPanel( - plotOutput(ns("plot")), - verbatimTextOutput(ns("code")) - ), - ) -} +```r +data()[[input$dataset]] +``` -# server function for the module -# presents datasets and numeric variables for selection -# displays a histogram of the selected variable -# displays code to reproduce the histogram -srv_histogram_example <- function(id, data) { +Here, `input$dataset` represents the name of the dataset selected by the user. This syntax is highly flexible because it dynamically references whichever dataset the user has chosen. You can further subset or manipulate this extracted data frame as needed. + +### Setting Up Server Logic Using `teal_data` and Dynamic Variable Injection + +In this updated server function, we will perform the following: + +1. **Create `new_data`** as a modified version of `data()` using `within()`, dynamically injecting `input$dataset` and `input$variable`. +2. **Render the Plot**: `renderPlot()` displays the plot by referencing the plot stored in the updated `teal_data` object, `new_data`. + +Here’s the code: + +```r +# Server function for the custom histogram module with injected variables in within() +histogram_module_server <- function(id, data) { moduleServer(id, function(input, output, session) { - # update dataset and variable choices - # each selection stored in separate reactive expression - updateSelectInput(inputId = "datasets", choices = isolate(names(data()))) - observe({ - req(dataset()) - nums <- vapply(data()[[dataset()]], is.numeric, logical(1L)) - updateSelectInput(inputId = "numerics", choices = names(nums[nums])) + + # Update dataset choices based on available datasets in teal_data + shiny::observe({ + shiny::updateSelectInput( + session, + "dataset", + choices = names(data()) + ) }) - dataset <- reactive(input$datasets) - selected <- reactive(input$numerics) - - # add plot code - plot_code_q <- reactive({ - validate(need(length(dataset()) == 1L, "Please select a dataset")) - validate(need(length(selected()) == 1L, "Please select a variable")) - req(selected() %in% names(data()[[dataset()]])) - - # evaluate plotting expression within data - # inject input values into plotting expression - within( + + # Update variable choices based on selected dataset, only including numeric variables + observeEvent(input$dataset, { + req(input$dataset) # Ensure dataset is selected + numeric_vars <- names(data()[[input$dataset]])[sapply(data()[[input$dataset]], is.numeric)] + shiny::updateSelectInput(session, "variable", choices = numeric_vars) + }) + + # Create a reactive `teal_data` object with the histogram plot + result <- reactive({ + req(input$dataset, input$variable) # Ensure both dataset and variable are selected + + # Create a new teal_data object with the histogram plot + new_data <- within( data(), - p <- hist(dataset[, selected], las = 1), - dataset = as.name(dataset()), selected = selected() + { + my_plot <- hist( + input_dataset[[input_vars]], + las = 1, + main = paste("Histogram of", input_vars), + xlab = input_vars, + col = "lightblue", + border = "black" + ) + }, + input_dataset = as.name(input$dataset), # Replace `input_dataset` with input$dataset + input_vars = input$variable # Replace `input_vars` with input$variable ) + new_data }) - # view plot - output$plot <- renderPlot({ - plot_code_q()[["p"]] + # Render the histogram from the updated teal_data object + output$histogram_plot <- shiny::renderPlot({ + result()[["my_plot"]] # Access and render the plot stored in `new_data` }) - # view code - output$code <- renderText({ - get_code(plot_code_q()) + # Reactive expression to get the generated code for the plot + output$plot_code <- shiny::renderText({ + teal.code::get_code(result()) # Retrieve and display the code for the updated `teal_data` object }) }) } +``` + +Let's review what we've done so far: + +1. **Dynamic Variable Injection with `within()`**: + - `input_dataset = as.name(input$dataset)` passes the dataset name dynamically as `input_dataset`. + - `input_vars = input$variable` passes the selected variable name directly as `input_vars`. + - Inside `within()`, `my_plot` uses these injected variables to dynamically generate the histogram plot. -# function that creates module instance to use in `teal` app -tm_histogram_example <- function(label) { - module( +2. **Rendering the Plot**: + - `output$histogram_plot` uses `renderPlot()` to display the plot stored in `new_data` by referencing `result()[["my_plot"]]`. + +3. **Plot Code Display**: + - The `output$plot_code` render function displays the dynamically generated code using `teal.code::get_code(result())`, allowing users to see the exact code used to generate the plot reactively. + +## Creating the Custom `teal` Module Function + +The `teal::module()` function allows you to encapsulate your UI and server logic into a `teal` module, making it reusable and ready to integrate into any `teal` application. + +By setting `datanames = "all"`, you give the module access to all datasets specified in the `teal_data` object. + +```r +# Custom histogram module creation +create_histogram_module <- function(label = "Histogram Module") { + teal::module( label = label, - server = srv_histogram_example, - ui = ui_histogram_example, + ui = histogram_module_ui, + server = histogram_module_server, datanames = "all" ) } ``` -This module is ready to be used in a `teal` app. +## Integrating the Custom `teal` Module into a `teal` App + +With the custom `teal` module set up, it can now be integrated into a `teal` app. +We’ll use `init()` from `teal` to specify the datasets and modules used in the app, then run the app to test the newly created module. + +```r +library(teal) + +# Define datasets in `teal_data` +data_obj <- teal_data( + iris = iris, + mtcars = mtcars +) -```{r} +# Initialize the teal app app <- init( - data = teal_data(IRIS = iris, NPK = npk), - modules = tm_histogram_example(label = "Histogram Module"), - header = "Simple app with custom histogram module" + data = data_obj, + modules = modules(create_histogram_module()) ) -if (interactive()) { - shinyApp(app$ui, app$server) -} +# Run the app +shiny::shinyApp(ui = app$ui, server = app$server) ``` -Teal Duck +**Congratulations! You just created a custom teal module and used it in a teal app!** + +This setup provides a fully dynamic, user-controlled `teal` module that allows for interactive data exploration and code visibility, enhancing both usability and transparency. + +## What's next? + +Now that you’ve mastered the essentials of building and integrating modules in `teal`, you’re ready to explore more advanced features. +`teal` offers a wide range of capabilities to enhance your module’s functionality and user experience. -## Adding reporting to a module -Refer to [this vignette](adding-support-for-reporting.html) to read about adding support for reporting in your `teal` module. +### Adding reporting to a module -## Using standard widgets in your custom module +Enhance your custom `teal` module with reporting features! Dive into [this vignette](adding-support-for-reporting.html) to see just how simple it is to add powerful reporting capabilities and elevate your module’s impact. -The [`teal.widgets`](https://insightsengineering.github.io/teal.widgets/latest-tag/) package provides various widgets which can be leveraged to quickly create standard elements in your custom module. +### Using standard widgets in your custom module +The [`teal.widgets`](https://insightsengineering.github.io/teal.widgets/latest-tag/) package provides various widgets which can be leveraged to quickly create standard elements in your custom `teal` module.