Geyser Shiny Modules
with Old Faithful

Brian S. Yandell

11 December 2024

Plan of Study

Build a Shiny Module [3-9]
- Faithful code [3-4]
- Modular Geyser App [5-6]
- Shiny Module in one File [7-9]
- Reactlog [10-11]
Connect Multiple Shiny Modules [12-18]
- Modules across Pages [12-13]
- Modules with Rows and Columns [14-15]
- Embed Switch in Module Demo [16-17]
- Twin & Flip Modules [18]
Explore Quarto Examples [19]
Organize your Repo [20]
- Clone my Repo [21]
Questions? Links to materials [22]

Original Old Faithful Code

inst/build_module/1_oldfaithful/app.R

ui <- bootstrapPage(
  selectInput(inputId = "n_breaks",
              label = "Number of bins in histogram (approximate):",
              choices = c(10, 20, 35, 50), selected = 20),
  checkboxInput(inputId = "individual_obs",
                label = strong("Show individual observations"),
                value = FALSE),
  checkboxInput(inputId = "density", label = strong("Show density estimate"),
                value = FALSE),
  plotOutput(outputId = "main_plot", height = "300px"),
  
  # Display this only if the density is shown
  conditionalPanel(condition = "input.density == true",
    sliderInput(inputId = "bw_adjust", label = "Bandwidth adjustment:",
      min = 0.2, max = 2, value = 1, step = 0.2))
)
server <- function(input, output) {
  output$main_plot <- renderPlot({
    hist(faithful$eruptions, probability = TRUE,
         breaks = as.numeric(input$n_breaks),
         xlab = "Duration (minutes)", main = "Geyser eruption duration")
    if (input$individual_obs) {
      rug(faithful$eruptions)
    }
    if (input$density) {
      dens <- density(faithful$eruptions, adjust = input$bw_adjust)
      lines(dens, col = "blue")
    }
  })
}
shiny::shinyApp(ui, server)

ui has input, output and conditional slider
server has hist and logic for optional rug and density

FaithFul code with Server Logic

inst/build_module/1_oldfaithful/appLogic.R

ui <- bootstrapPage(
  selectInput(inputId = "n_breaks",
  ...
  plotOutput(outputId = "main_plot", height = "300px"),
  
  # Display this only if the density is shown
  uiOutput("bw_adjust")
#  conditionalPanel(condition = "input.density == true",
#    sliderInput(inputId = "bw_adjust", label = "Bandwidth adjustment:",
#      min = 0.2, max = 2, value = 1, step = 0.2))
)
server <- function(input, output) {
  output$main_plot <- renderPlot({
  ...
    if (input$density) {
      req(input$bw_adjust)
      dens <- density(faithful$eruptions, adjust = input$bw_adjust)
      lines(dens, col = "blue")
    }
  })
  output$bw_adjust <- shiny::renderUI({
    if(input$density)
      sliderInput(inputId = "bw_adjust", label = "Bandwidth adjustment:",
                  min = 0.2, max = 2, value = 1, step = 0.2)
  })
}
shiny::shinyApp(ui, server)

Use uiOutput instead of conditionalPanelin ui.
Check density and bw_adjust in server before using.
Use renderUI in server to input bw_adjust if density.

Modular Geyser App

inst/build_module/4_moduleServer/app.R

ui <- bslib::page(
  geyserInput(id = "geyser"), 
  geyserOutput(id = "geyser"),
  # Display this only if the density is shown
  geyserUI(id = "geyser")
)
server <- function(input, output, session) {
  geyserServer(id = "geyser")
}
shiny::shinyApp(ui, server)

id = "geyser" connects UI and Server components.
Function geyserServer() returns a server function.
Explicit function assignment to create server is crucial.

Self-contained `geyserApp()` function

inst/build_module/4_moduleServer/moduleServer.R

geyserApp <- function() {
  ui <- bslib::page(
    geyserInput("geyser"), 
    geyserOutput("geyser"),
    # Display this only if the density is shown
    geyserUI("geyser")
  )
  server <- function(input, output, session) {
    geyserServer("geyser")
  }
  shiny::shinyApp(ui, server)
}

Shiny Module in one File

inst/build_module/4_moduleServer/moduleServer.R

geyserServer(id) # server logic steps
geyserInput(id)  # user input
geyserOutput(id) # user output
geyserUI(id)     # user input/output
geyserApp()      # app as test function

inst/build_module/4_moduleServer/moduleServer.R

Modular Geyser `Input`, `Output`, `UI` Components

inst/build_module/4_moduleServer/app.R

geyserInput <- function(id) {
  ns <- shiny::NS(id)
  shiny::tagList(
    shiny::selectInput(inputId = ns("n_breaks"),
                label = "Number of bins in histogram (approximate):",
                choices = c(10, 20, 35, 50),
                selected = 20),
    shiny::checkboxInput(inputId = ns("individual_obs"),
                  label = shiny::strong("Show individual observations"),
                  value = FALSE),
    
    shiny::checkboxInput(inputId = ns("density"),
                  label = shiny::strong("Show density estimate"),
                  value = FALSE))
}
geyserOutput <- function(id) {
  ns <- shiny::NS(id)
  shiny::plotOutput(ns("main_plot"), height = "300px")
}
geyserUI <- function(id) {
  ns <- shiny::NS(id)
  shiny::uiOutput(ns("bw_adjust"))
}

shiny::NS() sets up Shiny namespace.
shiny::tagList() for list of inputs.
Explicit package::function() clarifies function origin.

Modular `geyserServer`

inst/build_module/4_moduleServer/moduleServer.R

geyserServer <- function(id) {
  shiny::moduleServer(id, function(input, output, session) {
    ns <- session$ns
    
    # Output Main Plot
    output$main_plot <- shiny::renderPlot({
      graphics::hist(faithful$eruptions,
                     probability = TRUE,
                     breaks = as.numeric(input$n_breaks),
                     xlab = "Duration (minutes)",
                     main = "Geyser eruption duration")
      
      if (input$individual_obs) {
        graphics::rug(faithful$eruptions)
      }
      if (input$density) {
        shiny::req(input$bw_adjust)
        dens <- stats::density(faithful$eruptions,
                               adjust = input$bw_adjust)
        graphics::lines(dens, col = "blue")
      }
    })
    
    # Input Bandwidth Adjustment
    output$bw_adjust <- shiny::renderUI({
      if(input$density) {
        shiny::sliderInput(inputId = ns("bw_adjust"),
                           label = "Bandwidth adjustment:",
                           min = 0.2, max = 2, value = 1, step = 0.2)
      }
    })
  })
}

shiny::moduleServer returns server function.
session$ns sets up Shiny namespace.
ns("by_adjust") uses Shiny namespace.

Reactlog: Show App Reactivity

inst/reactlog

Reactlog: Show App Reactivity

inst/reactlog

# Enable `reactlog` and run app.
reactlog::reactlog_enable()
shiny::runApp("inst/build_module/4_moduleServer")

# Show `reactlog` in browser.
shiny::reactlogShow()

# Save log of reactive session.
geyser_log <- shiny::reactlog()
saveRDS(geyser_log, "inst/reactlog/geyser.rds")

# Retrieve previously saved reactive session.
geyser_log <- readRDS("inst/reactlog/geyser.rds")
reactlog::reactlog_show(geyser_log)

Read Shiny Reactlog article.
See inst/reactlog examples saved as RDS objects.
Re-open repo to reset reactlog before enabling.

Connecting Modules across Pages

Connecting Modules across Pages

inst/connect_modules/appPages.R

ui <- shiny::navbarPage("Geyser Modules with NavBar, Brian Yandell",
  shiny::tabPanel("hist",
    histInput("hist"), histOutput("hist"), histUI("hist")),
  shiny::tabPanel("gghist",
    gghistInput("gghist"), gghistOutput("gghist"), gghistUI("gghist")),
  shiny::tabPanel("ggpoint",
    ggpointInput("ggpoint"), ggpointOutput("ggpoint"), ggpointUI("ggpoint")))
server <- function(input, output, session) {
  histServer("hist")
  gghistServer("gghist")
  ggpointServer("ggpoint")
}
shiny::shinyApp(ui, server)

Connecting Module Rows and Columns

Connecting Modules Rows and Columns

inst/connect_modules/appRows.R

ui <- bslib::page(
  title = "Geyser Rows Modules",
    bslib::layout_columns(
      datasetsInput("datasets"),
      datasetsUI("datasets")),
  bslib::layout_columns(
    bslib::card(bslib::card_header("hist"),
      histInput("hist"), histOutput("hist"), histUI("hist")),
    bslib::card(bslib::card_header("gghist"),
      gghistInput("gghist"), gghistOutput("gghist"), gghistUI("gghist")),
    bslib::card(bslib::card_header("ggpoint"),
      ggpointInput("ggpoint"), ggpointOutput("ggpoint"), ggpointUI("ggpoint"))))
server <- function(input, output, session) {
  dataset <- datasetsServer("datasets")
  histServer("hist", dataset)
  gghistServer("gghist", dataset)
  ggpointServer("ggpoint", dataset)
}
shiny::shinyApp(ui, server)

inst/connect_modules/appRows.R: Shiny app version
inst/connect_modules/rows.qmd: Quarto version
R/rowsApp.R: Shiny module version
inst/connect_modules/appRowsModule.R: Shiny app with R/rowsApp.R functions

Connecting Modules with Plot Switch

R/switchApp.R

Connecting Modules with Plot Switch

R/switchApp.R

switchServer <- function(id) {
  shiny::moduleServer(id, function(input, output, session) {
    ns <- session$ns
    dataset <- datasetsServer("datasets")
    histServer("hist", dataset)
    gghistServer("gghist", dataset)
    ggpointServer("ggpoint", dataset)
    
    output$inputSwitch <- shiny::renderUI({
      shiny::req(input$plottype)
      get(paste0(input$plottype, "Input"))(ns(input$plottype))
    })
    output$uiSwitch <- shiny::renderUI({
      shiny::req(input$plottype)
      get(paste0(input$plottype, "UI"))(ns(input$plottype))
    })
    output$outputSwitch <- shiny::renderUI({
      shiny::req(input$plottype)
      get(paste0(input$plottype, "Output"))(ns(input$plottype))
    })
  })
}
switchInput <- function(id) {
  ns <- shiny::NS(id)
  list(
    bslib::layout_columns(
      shiny::selectInput(ns("plottype"), "Plot Type:",
                         c("hist","gghist","ggpoint")),
      datasetsInput(ns("datasets")),
      datasetsUI(ns("datasets"))),
    shiny::uiOutput(ns("inputSwitch"))
  )
}
switchUI <- function(id) {
  ns <- shiny::NS(id)
  shiny::uiOutput(ns("uiSwitch"))
}
switchOutput <- function(id) {
  ns <- shiny::NS(id)
  shiny::uiOutput(ns("outputSwitch"))
}
switchApp <- function() {
  ui <- bslib::page(
    switchInput("switch"), 
    switchUI("switch"),
    switchOutput("switch")
  )
  server <- function(input, output, session) {
    switchServer("switch")
  }
  shiny::shinyApp(ui, server)
}

Goofing Around with Duplicate Modules

inst/connect_modules/appTwin.R: twin apps side by side
inst/connect_modules/appFlip.R: flip controls between cards
inst/connect_modules/appDupe.R (does not work–need unique ids!)
inst/connect_modules/twin.qmd
inst/connect_modules/flip.qmd

Quarto Examples

View slideDeck.qmd written in Quarto.
Run Quarto examples in build_module & connect_modules.
See https://connect.doit.wisc.edu/geyserQuartoDemo.
Learn about Quarto through examples.
See my notes at https://github.com/byandell/quarto.

GitHub Repo Organization

byandell/geyser

- inst
  - build_module
    - 1_oldFaithful*
    - 2_newFaithful
    - 3_callModule
    - 4_moduleServer*
  - connect_modules
    - app.R*
    - appPages.R*
    - pages.qmd*
    - appRows.R*
    - rows.qmd*
  - slideDeck
    - images
    - slideDeck.qmd*
- R
  - histApp.R*
  - gghistApp.R*
  - ggpointApp.R*
  - datasetsApp.R*
  - switchApp.R*

Clone repo and run yourself

Clone this repo to your laptop

<https://github.com/byandell/geyser.git>

…

Run the oldFaithful app

> library(shiny)
> runApp("oldFaithful")

or …

Run the Faithful Module app

> shiny::runApp("moduleServer")

or …

Call the geyserApp() test function

> source("moduleServer/moduleServer.R")
> geyserApp()

Questions?

byandell.github.io

Geyser Shiny Moduleswith Old Faithful

Plan of Study

Original Old Faithful Code

FaithFul code with Server Logic

Modular Geyser App

Self-contained geyserApp() function

Shiny Module in one File

Modular Geyser Input, Output, UI Components

Modular geyserServer

Reactlog: Show App Reactivity

Reactlog: Show App Reactivity

Connecting Modules across Pages

Connecting Modules across Pages

Connecting Module Rows and Columns

Connecting Modules Rows and Columns

Connecting Modules with Plot Switch

Connecting Modules with Plot Switch

Goofing Around with Duplicate Modules

Quarto Examples

GitHub Repo Organization

Clone repo and run yourself

Questions?

Geyser Shiny Modules
with Old Faithful

Self-contained `geyserApp()` function

Modular Geyser `Input`, `Output`, `UI` Components

Modular `geyserServer`