Mastering Shiny: Shiny modules (apps)

library(msst2ap)
library(lobstr)
library(fs)

Mastering Shiny Apps

This vignette walks through the structure of each application using the abstract syntax tree (ast()) function from the lobstr package. Three of the applications in the msst2ap package come from the Modules section of Mastering Shiny, with a few adjustments:

Each standalone app function has a verbatimTextOutput() in the ui:
```
shiny::verbatimTextOutput("vals")
```

And an accompanying renderPrint() in the server:

output$vals <- shiny::renderPrint({
  x <- shiny::reactiveValuesToList(input,
                          all.names = TRUE)
  print(x)
})

Printing the output from shiny::reactiveValuesToList() in the top-level of the standalone function shows the namespaces and modules throughout the application.

`datasetApp()`

█─datasetApp 
├─filter = NULL 
└─█─shinyApp 
  ├─ui = █─fluidPage 
  │      ├─█─datasetInput 
  │      │ ├─id = "dataset" 
  │      │ ├─filter = is.data.frame 
  │      │ └─█─selectInput 
  │      │   └─inputId = "dataset" 
  │      └─█─tableOutput 
  │        └─"data"
  └─server = █─function(input, output, session)
             └─█─data <- datasetServer(id = "dataset") 
               └─output$data <- renderTable(head(data()))

datasetApp() contains the datasetInput() and datasetServer() module functions

datasetInput() displays the objects from the datasets package ("dataset") matching the filter argument (i.e., is.data.frame, is.matrix) and the table output ("data") in the UI
The inputId in the UI passes a datasets object (as input$dataset, a character string) to datasetServer(), which fetches and returns the object as a reactive via get()

`datasetApp()` Reactive values

The output from reactiveValuesToList() are displayed in the UI:

$`dataset-dataset`
[1] "ability.cov"

The first dataset is from the module id, and the second is from the inputId (in the selectInput()).

`selectVarApp()`

selectVarApp() contains the datasetInput()/Server() and selectVarInput()/Server() modules

█─selectVarApp 
└─█─shinyApp 
  ├─ui = █─fluidPage 
  │      ├─█─datasetInput 
  │      │ ├─id = "data" 
  │      │ ├─filter = is.data.frame
  │      │ └─█─selectInput 
  │      │   └─inputId = "dataset" 
  │      ├─█─selectVarInput 
  │      │ ├─id = "var" 
  │      │ └─█─selectInput 
  │      │   └─inputId = "var" 
  │      └─█─tableOutput 
  │        └─"out" 
  └─server = █─function(input, output, session)
             └─█─data <- datasetServer("data")
               █─var <- selectVarServer("var", data, filter = is.numeric)
               └─output$out <- renderTable(head(var()))

dataset module:
- datasetInput("data")
- datasetServer("data")
selectVar module:
- selectVarInput() displays the variables (columns) in the returned datasets object from datasetServer() (as "var") and the rendered output (as "out")
- In selectVarServer(), the columns in the data returned from datasetServer() is filtered to those columns matching the filter argument (i.e., is.numeric), and the selected "var" is displayed in "out"

`selectVarApp()` Adjustments

The variable value from selectVarServer() was originally returned with a simple call to reactive()

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 = session,
        inputId = "var", 
        choices = find_vars(data = data(), filter = filter))
    })
    
    reactive(data()[[input$var]]) # <- simple reactive()
    
  })
}

I’ve updated this with some control flow statements to ensure the variable is contained the data object. I’ve also changed the returned object to be a single column data.frame (as opposed to a vector):

selectVarServer <- function(id, data, filter = is.numeric) {
  stopifnot(shiny::is.reactive(data))
  stopifnot(!shiny::is.reactive(filter))

  shiny::moduleServer(id, function(input, output, session) {

    shiny::observe({
      shiny::updateSelectInput(
        session, "var",
        choices = find_vars(data(), filter))
    }) |>
      shiny::bindEvent(data())

    return(
      shiny::reactive({
        if (input$var %in% names(data())) { # <- updated with control flow
          data()[input$var] # returned as a single column
        } else {
          NULL
        }
      }) |>
      shiny::bindEvent(input$var)
    )

  })
}

`selectVarApp()` Reactive values

The reactiveValuesToList() output for both modules are below:

$`var-var`
[1] "Ozone"

$`data-dataset`
[1] "airquality"

The first "var" is from the shared id between selectVarInput()/selectVarServer(), the second is from the inputId in the selectInput().
"data" is from the shared id between datasetInput()/datasetServer(), and the second is from the selectInput().

`selectDataVarApp()`

█─selectDataVarApp 
└─█─shinyApp 
  ├─ui = █─fluidPage 
  │      └─█─sidebarLayout 
  │        ├─█─sidebarPanel 
  │        │ └─█─selectDataVarUI 
  │        │   ├─"var" 
  │        │   ├─█─datasetInput 
  │        │   │ ├─█─NS 
  │        │   │ │ ├─id 
  │        │   │ │ └─"data" 
  │        │   │ └─filter = is.data.frame 
  │        │   └─█─selectVarInput 
  │        │     └─█─NS 
  │        │       ├─id 
  │        │       └─"var" 
  │        └─█─mainPanel 
  │          └─█─tableOutput 
  │            └─"out" 
  └─server = █─function(input, output, session)
             ├─█─var <- selectDataVarServer(id = "var", filter = is.numeric)
             │ ├─data <- datasetServer(id = "data")
             │ ├─var <- selectVarServer(id = "var", data, filter = filter) 
             │ └─var 
             └─output$out <- renderTable(head(var()))

selectDataVarApp() nests the dataset and selectVar modules inside the selectDataVarUI() and selectDataVarServer() functions:

Inside selectDataVarUI():

datasetInput("data"):
- datasetInput() is moved into the sidebarPanel() to display the objects from the datasets package ("dataset") matching the filter argument (i.e., is.data.frame, is.matrix)
selectVarInput("var"):
- selectVarInput("var") also displays the variables in the sidebarPanel() from the returned data object in datasetServer()

Inside selectDataVarServer():

datasetServer():
- The inputId in the UI passes a datasets object (as input$dataset, a character string) to datasetServer(), which fetches and returns the object as a reactive with get()
selectVarServer():
- In selectVarServer(), the columns in the data returned from datasetServer() are filtered to only those columns matching the filter argument (i.e., is.numeric), and the selected "var" is returned as var
- The var() reactive output is rendered in the UI

`selectDataVarApp()` Reactive values

By placing the datasetInput() and selectVarInput() functions inside selectDataVar() with another call to NS(), these functions end up with two appended namespaces:

$`var-var-var`
[1] "Ozone"

$`var-data-dataset`
[1] "airquality"

`histogramApp()`

█─histogramApp 
└─█─shinyApp 
  ├─ui = █─fluidPage 
  │      ├─█─sidebarLayout 
  │      │ └─█─sidebarPanel 
  │      │   ├─█─datasetInput 
  │      │   │ ├─"data" 
  │      │   │ └─filter = is.data.frame 
  │      │   └─█─selectVarInput 
  │      │     └─"var" 
  │      └─█─mainPanel 
  │        └─█─histogramOutput 
  │          └─"hist" 
  └─server = █─function(input, output, session)
             ├─data <- datasetServer('data')
             ├─x <- selectVarServer('var', data)
             ├─histogramServer('hist', x) 
             └─output$out <- renderPrint(head(var()))

This histogramApp() function has been slightly altered to accommodate converting the graph output to use ggplot2.

Adjustments

The original histogramServer() function uses shiny::req() to ensure the x() reactive is numeric (is.numeric()). It then passes this numeric vector directly to hist() (along with the breaks and title (in main)).

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)
  })
}

I’ve changed histogramServer() slightly: I removed the is.numeric() function from shiny::req() and use purrr::as_vector() to convert the single column data.frame to a vector:

histogramServer <- function(id, x, title = reactive("Histogram")) {
  stopifnot(shiny::is.reactive(x))
  stopifnot(shiny::is.reactive(title))

  shiny::moduleServer(id, function(input, output, session) {

    output$hist <- shiny::renderPlot({
      shiny::req(x()) # require x() (but not numeric) 
      main <- paste0(title(), " [bins =", input$bins, "]")
      hist(
        purrr::as_vector(x()), # convert the single column data.frame to a vector
        breaks = input$bins,
        main = main)
    }, res = 96)

  })
}

Reactive values

The output from reactiveValuesToList() is below:

$`hist-bins`
[1] 10

$`var-var`
[1] "Ozone"

$`data-dataset`
[1] "airquality"

The reason all of these modules are interchangeable is that none of them deal with rendering outputs–all of the *Output()/render()* functions are kept in the standalone application functions.

Mastering Shiny Apps

datasetApp()

datasetApp() Reactive values

selectVarApp()

selectVarApp() Adjustments

selectVarApp() Reactive values

selectDataVarApp()

selectDataVarApp() Reactive values

histogramApp()