From 3bdf00e25469780844a927a71a0a10ee91d7965d Mon Sep 17 00:00:00 2001 From: Angel Feliz Date: Sun, 12 May 2024 03:12:46 -0400 Subject: [PATCH] ending base theory --- 19-modules.Rmd | 414 +++++++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 405 insertions(+), 9 deletions(-) diff --git a/19-modules.Rmd b/19-modules.Rmd index a07bdd4..060a3dd 100644 --- a/19-modules.Rmd +++ b/19-modules.Rmd @@ -38,7 +38,7 @@ Modules are a kind of **miniature app** within a larger app that isolate a parti ![](images/19-modules/02-after-modules.png){width=50% height=50%} -## Simple histogram app {-} +## App 1: Before applying modules {-} ```{r, eval=FALSE} ui <- fluidPage( @@ -54,7 +54,7 @@ server <- function(input, output, session) { } ``` -## Creating UI function {-} +## App 1: UI function {-} 1. Create a function with the `id` argument. 2. Wrap all components in the `tagList` function to **bundle together multiple components** without actually implying how they’ll be laid out. @@ -70,7 +70,7 @@ histogramUI <- function(id) { } ``` -## Using NS once {-} +## App 1: UI using NS once {-} From `shiny::NS()` documentation. @@ -87,7 +87,7 @@ histogramUI <- function(id) { } ``` -## Module server {-} +## App 1: Module server {-} 1. Create a function with the ID argument. 2. Call the `shiny::moduleServer()` and pass the id and a **function that looks like a regular server function**. @@ -106,7 +106,7 @@ histogramServer <- function(id) { ``` -## Confirm that the model works {-} +## App 1: Module app {-} We can create a custom function to validate that each modele is working. @@ -122,7 +122,7 @@ histogramApp <- function() { } ``` -## Confirm that the model works (Shinylive) {-} +## App 1: Module app (Shinylive) {-} @@ -289,16 +289,412 @@ ui <- page_fluid( +## Inputs and outputs {-} + +- **Adding arguments to the module UI** gives greater control over module appearance. + +- **Connecting modules together** requires you to be explicit about inputs and outputs for the module server. + - Much easier to understand + - Allows you to build substantially more complex apps + + +## App 2: Select data (UI) {-} + +Allows the user to select a dataset after confirming if the data is data.frame (`filter = is.data.frame`) or a matrix (`filter = is.matrix`) + +limit the options to built-in datasets that are either data frames + +```{r eval=FALSE} +datasetInput <- function(id, filter = NULL) { + names <- ls("package:datasets") + if (!is.null(filter)) { + data <- lapply(names, get, "package:datasets") + names <- names[vapply(data, filter, logical(1))] + } + + selectInput(NS(id, "dataset"), "Pick a dataset", choices = names) +} +``` + +## App 2: Select data (SERVER) {-} + +The module server uses `get()` to retrieve the dataset return a **reactive value** rather than defining some *output*. + +```{r eval=FALSE} +datasetServer <- function(id) { + moduleServer(id, function(input, output, session) { + reactive(get(input$dataset, "package:datasets")) + }) +} +``` + +## App 2: Select data (APP) {-} + +Now, in the module app we need to **capture its return** value with `<-`. + +```{r eval=FALSE} +datasetApp <- function(filter = NULL) { + ui <- fluidPage( + datasetInput("dataset", filter = filter), + tableOutput("data") + ) + server <- function(input, output, session) { + data <- datasetServer("dataset") + output$data <- renderTable(head(data())) + } + shinyApp(ui, server) +} +``` + +## App 2: Select data (Shinylive) {-} + + + +## App 2: Extracting a numeric variable (UI) {-} + +create a control that allows the user to select variables of specified type from a given reactive dataset. + +```{r eval=FALSE} +selectVarInput <- function(id) { + selectInput(NS(id, "var"), "Variable", choices = NULL) +} +``` + + +## App 2: Extracting a numeric variable (SERVER) {-} + +1. Create a function to list all columns that meet the condition passed to the `filter` argument as a function. + +```{r eval=FALSE} +find_vars <- function(data, filter) { + names(data)[vapply(data, filter, logical(1))] +} +``` + +2. Update the select input element in the UI with columns that meet the condition and extract the selected column from the reactive dataset. + +```{r eval=FALSE} +selectVarServer <- function(id, data, filter = is.numeric) { + + moduleServer(id, function(input, output, session) { + + observeEvent(data(), { + updateSelectInput(session, "var", choices = find_vars(data(), filter)) + }) + + reactive(data()[[input$var]]) + }) + +} + +``` + +## App 2: Extracting a numeric variable (APP) {-} + +```{r eval=FALSE} +selectVarApp <- function(filter = is.numeric) { + + ui <- fluidPage( + datasetInput("data", is.data.frame), + selectVarInput("var"), + verbatimTextOutput("out") + ) + + server <- function(input, output, session) { + data <- datasetServer("data") + var <- selectVarServer("var", data, filter = filter) + output$out <- renderPrint(var()) + } + + shinyApp(ui, server) + +} +``` + + +## App 2: Extracting a numeric variable (Shinylive) {-} + + + +## Tip: Validate if reactive {-} + +**Check that each input to your module is either reactive or constant** + +1. Makes the life of module user much easier. +2. Avoids a common problem when mixing modules with other input controls. + +*Sometimes the solution can be wraping the value* in the `reactive()` function like `selectVarServer("var", reactive(input$x))`. + +## Tip: Validate if reactive {-} + +```{r eval=FALSE} +selectVarServer <- function(id, data, filter = is.numeric) { + stopifnot(is.reactive(data)) + stopifnot(!is.reactive(filter)) + + moduleServer(id, function(input, output, session) { + observeEvent(data(), { + updateSelectInput(session, "var", choices = find_vars(data(), filter)) + }) + + reactive(data()[[input$var]]) + }) +} +``` + +## Tip: Validate the input of each argument {-} + +**Debugging Shiny apps is a little harder than debugging regular R code**. + +```{r eval=FALSE} +find_vars <- function(data, filter) { + stopifnot(is.data.frame(data)) + stopifnot(is.function(filter)) + names(data)[vapply(data, filter, logical(1))] +} +``` + +## App 3: Modules consolidation (UI) {-} + +We could combine the `dataset` and `selectVar` modules in single one. + +```{r, eval=FALSE} +selectDataVarUI <- function(id) { + tagList( + datasetInput(NS(id, "data"), filter = is.data.frame), + selectVarInput(NS(id, "var")) + ) +} +``` + +## App 3: Modules consolidation (SERVER) {-} + +We could combine the `dataset` and `selectVar` modules in single one. + +```{r eval=FALSE} +selectDataVarServer <- function(id, filter = is.numeric) { + moduleServer(id, function(input, output, session) { + data <- datasetServer("data") + var <- selectVarServer("var", data, filter = filter) + var + }) +} +``` + + +## App 3: Modules consolidation (APP) {-} + +```{r eval=FALSE} +selectDataVarApp <- function(filter = is.numeric) { + ui <- fluidPage( + sidebarLayout( + sidebarPanel(selectDataVarUI("var")), + mainPanel(verbatimTextOutput("out")) + ) + ) + server <- function(input, output, session) { + var <- selectDataVarServer("var", filter) + output$out <- renderPrint(var(), width = 40) + } + shinyApp(ui, server) +} +``` + + +## App 3: Modules consolidation (Shinylive) {-} + + + +## Tip: Modules challenge {-} + +Modules functions must be: + +- Flexible enough to be used in multiple places. +- Simple enough that they can easily be understood. + +***Expect that you’ll have to do it wrong quite a few times before you get it right.*** + +## App 4: Bind and Histogram (UI) {-} + +We can create a module to define the number of bins and display the histogram. + +```{r eval=FALSE} +histogramOutput <- function(id) { + tagList( + numericInput(NS(id, "bins"), "bins", 10, min = 1, step = 1), + plotOutput(NS(id, "hist")) + ) +} +``` + +## App 4: Bind and Histogram (SERVER) {-} + +Using two reactive arguments: + +- `x` as the variable to plot +- `title` for the histogram + +```{r eval=FALSE} +histogramServer <- function(id, x, title = reactive("Histogram")) { + stopifnot(is.reactive(x)) + stopifnot(is.reactive(title)) + + moduleServer(id, function(input, output, session) { + output$hist <- renderPlot({ + req(is.numeric(x())) + main <- paste0(title(), " [", input$bins, "]") + hist(x(), breaks = input$bins, main = main) + }, res = 96) + }) +} +``` + +## App 4: Reusing modules (APP) {-} + +```{r eval=FALSE} +histogramApp <- function() { + ui <- fluidPage( + sidebarLayout( + sidebarPanel( + datasetInput("data", is.data.frame), + selectVarInput("var"), + ), + mainPanel( + histogramOutput("hist") + ) + ) + ) + + server <- function(input, output, session) { + data <- datasetServer("data") + x <- selectVarServer("var", data) + histogramServer("hist", x) + } + shinyApp(ui, server) +} +``` + +## App 4: Reusing modules (Shinylive) {-} + + + +## Tip: Spitting Module UI {-} + +It will give to separate elements in the UI depending of the **same server module**. + +```{r eval=FALSE} +histogramOutputBins <- function(id) { + numericInput(NS(id, "bins"), "bins", 10, min = 1, step = 1) +} +histogramOutputPlot <- function(id) { + plotOutput(NS(id, "hist")) +} +``` + +## Tip: Spitting Module UI {-} + +Please note that both functions are using the **same id**. + +```{r eval=FALSE} +ui <- fluidPage( + sidebarLayout( + sidebarPanel( + datasetInput("data", is.data.frame), + selectVarInput("var"), + histogramOutputBins("hist") + ), + mainPanel( + histogramOutputPlot("hist") + ) + ) +) +``` + + +## Tip: Spitting Module UI (Shinylive) {-} + + + + +## Tip: Multiple output (SERVER) {-} + +To solve this problem you just need to wrap all your outputs in a `list()`. + +Now we can change the title of the histogran. + +```{r eval=FALSE} +selectVarServer <- function(id, data, filter = is.numeric) { + stopifnot(is.reactive(data)) + stopifnot(!is.reactive(filter)) + + moduleServer(id, function(input, output, session) { + observeEvent(data(), { + updateSelectInput(session, "var", choices = find_vars(data(), filter)) + }) + + list( + name = reactive(input$var), + value = reactive(data()[[input$var]]) + ) + }) +} +``` + +## Tip: Multiple output (APP) {-} + +Don't forget to evaluate `x$value()` rather than as we want the module to **react to the value changing**. + +```{r eval=FALSE} +histogramApp <- function() { + ui <- fluidPage(...) + + server <- function(input, output, session) { + data <- datasetServer("data") + x <- selectVarServer("var", data) + histogramServer("hist", x$value, x$name) + } + shinyApp(ui, server) +} +``` + +## Tip: Multiple output (APP) {-} + +We can all also eliminate that layer of indirection by using the `%<-%` from the zeallot package. + +```{r eval=FALSE} +library(zeallot) + +histogramApp <- function() { + ui <- fluidPage(...) + + server <- function(input, output, session) { + data <- datasetServer("data") + c(value, name) %<-% selectVarServer("var", data) + histogramServer("hist", value, name) + } + shinyApp(ui, server) +} +``` + + +## Tip: Multiple output (Shinylive) {-} + + + ## Links to examples {-} Two versions of a simple app based on Tidy Tuesday data: + * [Shiny dashboard](https://github.com/jakelawlor/Volcano_Shiny_App) * [golem with modules](https://github.com/bios2/shiny_volcano_golem) -https://github.com/deepshamenghani/Demystifying_Shiny_modules -https://github.com/hypebright/shinyconf2024-shiny101 + +Examples provided in the 2024 Shiny Conference: + +* https://github.com/deepshamenghani/Demystifying_Shiny_modules +* https://github.com/hypebright/shinyconf2024-shiny101 -## Meeting Videos +## Meeting Videos {-} ### Cohort 1