Dynamic UIs

Colin Rundel

Downloading

`downloadButton()`

This is a special UI input widget designed to launch a download window from your Shiny app.

downloadButton() is a special case of an actionButton() with specialized server syntax. These are different from the other inputs we’ve used this far as they are primarily used to trigger an action rather than return a value.

Rahter than using an observe() or render*(), this widgte is paired with the special downloadHandler() which uses the latter’s syntax in our server function.

`downloadHandler()`

Specifically, within our server definition we attach the downloadHandler() to the button’s id via output, e.g.

output$download_btn = downloadHandler(...)

The handler then defines a filename function for generating a default filename and a content function for writing the download file’s content to a temporary file, which is then served by Shiny for downloading by the user.

Demo 06 - A download button

demos/demo06.R

library(tidyverse)
library(shiny)

d = readr::read_csv(here::here("data/weather.csv"))

d_vars = c("Average temp" = "temp_avg",
           "Min temp" = "temp_min",
           "Max temp" = "temp_max",
           "Total precip" = "precip",
           "Snow depth" = "snow",
           "Wind direction" = "wind_direction",
           "Wind speed" = "wind_speed",
           "Air pressure" = "air_press")

ui = fluidPage(
  titlePanel("Weather Data"),
  sidebarLayout(
    sidebarPanel(
      selectInput(
        "region", "Select a region",
        choices = sort(unique(d$region)),
        selected = "West"
      ),
      selectInput(
        "name", "Select an airport",
        choices = c()
      ),
      selectInput(
        "var", "Select a variable",
        choices = d_vars, selected = "temp_avg"
      ),
      downloadButton("download")
    ),
    mainPanel( 
      plotOutput("plot")
    )
  )
)

server = function(input, output, session) {
  
  output$download = downloadHandler(
    filename = function() {
      paste0(
        input$name |>
          stringr::str_replace(" ", "_") |>
          tolower(), 
        ".csv"
      )
    },
    content = function(file) {
      readr::write_csv(d_city(), file)
    }
  )
  
  d_city = reactive({
    req(input$name)
    d |>
      filter(name %in% input$name)
  })
  
  observe({
    updateSelectInput(
      session, "name",
      choices = d |>
        distinct(region, name) |>
        filter(region == input$region) |>
        pull(name)
    )
  })
  
  output$plot = renderPlot({
    d_city() |>
      ggplot(aes(x=date, y=.data[[input$var]])) +
      ggtitle(input$var) +
      geom_line() +
      theme_minimal()
  })
}

shinyApp(ui = ui, server = server)

`bindEvent()`

For both observers and reactive expressions Shiny will automatically determine reactive dependencies for you - in some cases this is not what we want.

To explicitly control the dependencies of reactive expressions, render functions, and observers we can modify them using bindEvent() where the dependencies are explicitly listed

Similar effects can be achieved via observeEvent() / eventReactive() but these have been soft deprecated as of Shiny 1.6.

Demo 07 - A fancy download button

demos/demo07.R

library(tidyverse)
library(shiny)

d = readr::read_csv(here::here("data/weather.csv"))

d_vars = c("Average temp" = "temp_avg",
           "Min temp" = "temp_min",
           "Max temp" = "temp_max",
           "Total precip" = "precip",
           "Snow depth" = "snow",
           "Wind direction" = "wind_direction",
           "Wind speed" = "wind_speed",
           "Air pressure" = "air_press")

ui = fluidPage(
  titlePanel("Weather Data"),
  sidebarLayout(
    sidebarPanel(
      selectInput(
        "region", "Select a region",
        choices = sort(unique(d$region)),
        selected = "West"
      ),
      selectInput(
        "name", "Select an airport",
        choices = c()
      ),
      selectInput(
        "var", "Select a variable",
        choices = d_vars, selected = "temp"
      ),
      actionButton("download_modal", "Download")
    ),
    mainPanel( 
      plotOutput("plot")
    )
  )
)

server = function(input, output, session) {
  
  observe({
    showModal( modalDialog(
      title = "Download data",
      shiny::dateRangeInput(
        "dl_dates", "Select date range",
        start = min(d_city()$date), end = max(d_city()$date)
      ),
      checkboxGroupInput(
        "dl_vars", "Select variables to download",
        choices = names(d), selected = names(d), inline = TRUE
      ),
      footer = list(
        downloadButton("download"),
        modalButton("Cancel")
      )
    ) )
  }) |>
    bindEvent(input$download_modal)
  
  output$download = downloadHandler(
    filename = function() {
      paste0(
        input$name |>
          stringr::str_replace(" ", "_") |>
          tolower(), 
        ".csv"
      )
    },
    content = function(file) {
      readr::write_csv(
        d_city() |>
          filter(date >= input$dl_dates[1] & date <= input$dl_dates[2]) |>
          select(input$dl_vars), 
        file
      )
    }
  )
  
  d_city = reactive({
    req(input$name)
    d |>
      filter(name %in% input$name)
  })
  
  observe({
    updateSelectInput(
      inputId = "name", 
      choices = d |>
        filter(region == input$region) |>
        pull(name) |>
        unique() |>
        sort()
    )
  })
  
  output$plot = renderPlot({
    d_city() |>
      ggplot(aes(x=date, y=.data[[input$var]])) +
      ggtitle(input$var) +
      geom_line() +
      theme_minimal()
  })
}

shinyApp(ui = ui, server = server)

Uploading

`fileInput()` widget

This widget behaves a bit differently than the others we have seen - before the file is uploaded, the input will return NULL. After file(s) are uploaded the input returns a data frame with one row per file and the following columns:

name - the original filename (from the client’s system)
size - file size in bytes
type - file mime type, usually determined by the file extension
datapath - location of the temporary file on the server

Given this data frame, your app’s server code is responsible for the processing and reading in the uploaded file(s).

Using `fileInput()`

library(tidyverse)
library(shiny)

ui = fluidPage(
  titlePanel("File Upload"),
  sidebarLayout(
    sidebarPanel(
      fileInput("upload", "Upload a file", accept = ".csv")
    ),
    mainPanel( 
      h3("Result"),
      tableOutput("result"),
      h3("Content:"),
      tableOutput("data")
    )
  )
)

server = function(input, output, session) {
  output$result = renderTable({
    req(input$upload)
    input$upload
  })
  
  output$data = renderTable({
    req(input$upload)
    ext = tools::file_ext(input$upload$datapath)
    
    validate(
      need(ext == "csv", "Please upload a csv file")
    )
    
    readr::read_csv(input$upload$datapath)
  })
}

shinyApp(ui = ui, server = server)

`fileInput()` hints

input$upload will default to NULL when the app is loaded, using req(input$upload) for downstream consumers is a good idea
Files in datapath are temporary and should be treated as ephemeral
- additional uploads can result in the previous files being deleted
type is at best a guess - validate uploaded files and write defensive code
The accept argument helps to limit file types but cannot prevent bad uploads

Your turn - Exercise 05

Starting with the code in exercises/ex05.R replace the preloading of the weather data (d) with a reactive() version that is populated via a fileInput() widget.

You should then be able to get the same app behavior as before once data/weather.csv is uploaded. You can also check that your app works with the data/portland.csv dataset as well.

Hint - remember that anywhere that uses either d will now need to use d() instead.

12:00

Modern UIs with bslib

Shiny & bootstrap

Much of the interface provided by Shiny is based on the html elements, styling, and javascript provided by the Bootstrap library.

Knowing the specifics of html (and Bootstrap specifically) are not needed for working with Shiny - but understanding some of its conventions goes a long way to helping you customize the elements of your app (via custom CSS and other tools).

This is not the only place that Bootstrap shows up in the R ecosystem - both RMarkdown and Quarto html documents use Bootstrap for styling as well.

bslib

The bslib R package provides a modern UI toolkit for Shiny, R Markdown, and Quarto based on Bootstrap.

It provides,

Custom theming of Shiny apps and R Markdown documents
Switch between different versions of Bootstrap
Modern UI components like cards, value boxes, sidebars, and more.

This last set of features is what we will focus on now, with more on the first two after the break.

Cards

Cards are a UI element that you will recognize from many modern websites. They are rectangular containers with borders and padding that are used to group related information. When utilized properly to group related information, they help users better digest, engage, and navigate through content

card(
  card_header(
    "A header"
  ),
  card_body(
    shiny::markdown(
      "Some **bold** text"
    )
  )
)

Styling cards

Cards can be styled using the class argument, this is used to apply Bootstrap classes to the card and its components.

card(
  max_height = 250,
  card_header(
    "Long scrollable text",
    class = "bg-primary"
  ),
  card_body(
    lorem::ipsum(paragraphs = 3, sentences = 5),
    class = "bg-info"
  )
)

Multiple card bodies

Cards are also super flexible and can contain multiple card_body() elements. This can be useful for creating complex layouts.

card(
  max_height = 450,
  card_header(
    "Text and a map!",
    class = "bg-dark"
  ),
  card_body(
    max_height = 200, 
    class = "p-0",
    leaflet::leaflet() |>
      leaflet::addTiles()
  ),
  card_body(
    lorem::ipsum(
      paragraphs = 1, 
      sentences = 3
    )
  )
)

Value boxes

Value boxes are the other major UI component provided by bslib. They are a simple way to display a value and a label in a styled box. They are often used to display key metrics in a dashboard.

value_box(
  title = "1st value",
  value = 123,
  showcase = bs_icon("bar-chart"),
  theme = "primary",
  p("The 1st detail")
)

value_box(
  title = "2nd value",
  value = 456,
  showcase = bs_icon("graph-up"),
  theme = "secondary",
  p("The 2nd detail"),
  p("The 3rd detail")
)

Demo 08 - Shiny + bslib

demos/demo08.R

library(tidyverse)
library(shiny)
library(bslib)

d = readr::read_csv(here::here("data/weather.csv"))

d_vars = c("Average temp" = "temp_avg",
           "Min temp" = "temp_min",
           "Max temp" = "temp_max",
           "Total precip" = "precip",
           "Snow depth" = "snow",
           "Wind direction" = "wind_direction",
           "Wind speed" = "wind_speed",
           "Air pressure" = "air_press",
           "Total sunshine" = "total_sun")

ui = page_sidebar(
  title = "Weather Data",
  sidebar = sidebar(
    selectInput(
      "region", "Select a region", 
      choices = c("West", "Midwest", "Northeast", "South")
    ),
    selectInput(
      "name", "Select an airport", choices = c()
    ),
    selectInput(
      "var", "Select a variable",
      choices = d_vars, selected = "temp_avg"
    )
  ),
  card(
    card_header(
      textOutput("title")
    ),
    card_body(
      plotOutput("plot")
    )
  )
)


server = function(input, output, session) {
  observe({
    updateSelectInput(
      session, "name",
      choices = d |>
        distinct(region, name) |>
        filter(region == input$region) |>
        pull(name)
    )
  })
  
  output$title = renderText({
    names(d_vars)[d_vars==input$var]
  })
  
  d_city = reactive({
    req(input$name)
    d |>
      filter(name %in% input$name)
  })
  
  output$plot = renderPlot({
    d_city() |>
      ggplot(aes(x=date, y=.data[[input$var]])) +
      geom_line() +
      theme_minimal()
  })
}

shinyApp(ui = ui, server = server)

Dynamic UIs

Adding value boxes

Previously we had included a table that showed minimum and maximum temperatures - lets try presenting these using value boxes instead.

Before we get to the code lets think a little bit about how we might do this.

value_box(
  title = "Average Temp",
  value = textOutput("avgtemp"),
  showcase = bsicons::bs_icon("thermometer-half"),
  theme = "success"
)

Any one see a potential issue with this?

`uiOutput()` and `renderUI()`

To handle situations like this Shiny provides the ability to dynamically generate UI elements entirely within the server function.

For our case we can create all of the value boxes we need in a single renderUI() call making our code simpler and more maintainable.

Additionally, since renderUI() is a reactive context we can perform all of our calculations in the same place .

Demo 09 - Value boxes

demos/demo09.R

library(tidyverse)
library(shiny)
library(bslib)

d = readr::read_csv(here::here("data/weather.csv"))

d_vars = c("Average temp" = "temp_avg",
           "Min temp" = "temp_min",
           "Max temp" = "temp_max",
           "Total precip" = "precip",
           "Snow depth" = "snow",
           "Wind direction" = "wind_direction",
           "Wind speed" = "wind_speed",
           "Air pressure" = "air_press",
           "Total sunshine" = "total_sun")

ui = page_sidebar(
  title = "Weather Data",
  sidebar = sidebar(
    selectInput(
      "region", "Select a region", 
      choices = c("West", "Midwest", "Northeast", "South")
    ),
    selectInput(
      "name", "Select an airport", choices = c()
    ),
    selectInput(
      "var", "Select a variable",
      choices = d_vars, selected = "temp_avg"
    )
  ),
  card(
    card_header(
      textOutput("title")
    ),
    card_body(
      plotOutput("plot")
    )
  ),
  uiOutput("valueboxes")
)

server = function(input, output, session) {
  observe({
    updateSelectInput(
      session, "name",
      choices = d |>
        distinct(region, name) |>
        filter(region == input$region) |>
        pull(name)
    )
  })
  
  output$valueboxes = renderUI({
    clean = function(x) {
      round(x,1) |> paste("°C")
    }
    
    layout_columns(
      value_box(
        title = "Average Temp",
        value = mean(d_city()$temp_avg, na.rm=TRUE) |> clean(),
        showcase = bsicons::bs_icon("thermometer-half"),
        theme = "success"
      ),
      value_box(
        title = "Minimum Temp",
        value = min(d_city()$temp_min, na.rm=TRUE) |> clean(),
        showcase = bsicons::bs_icon("thermometer-snow"),
        theme = "primary"
      ),
      value_box(
        title = "Maximum Temp",
        value = max(d_city()$temp_max, na.rm=TRUE) |> clean(),
        showcase = bsicons::bs_icon("thermometer-sun"),
        theme = "danger"
      )
    )
  })
  
  output$title = renderText({
    names(d_vars)[d_vars==input$var]
  })
  
  d_city = reactive({
    req(input$name)
    d |>
      filter(name %in% input$name)
  })
  
  output$plot = renderPlot({
    d_city() |>
      ggplot(aes(x=date, y=.data[[input$var]])) +
      geom_line() +
      theme_minimal()
  })
}

shinyApp(ui = ui, server = server)

Demo 10 - bslib Bells and Whistles

demos/demo10.R

library(tidyverse)
library(shiny)
library(bslib)

d = readr::read_csv(here::here("data/weather.csv"))

d_vars = c("Average temp" = "temp_avg",
           "Min temp" = "temp_min",
           "Max temp" = "temp_max",
           "Total precip" = "precip",
           "Snow depth" = "snow",
           "Wind direction" = "wind_direction",
           "Wind speed" = "wind_speed",
           "Air pressure" = "air_press")

ui = page_sidebar(
  title = "Weather Data",
  sidebar = sidebar(
    selectInput(
      "region", "Select a region", 
      choices = c("West", "Midwest", "Northeast", "South")
    ),
    selectInput(
      "name", "Select an airport", choices = c()
    ),
    
  ),
  card(
    card_header(
      textOutput("title"),
      popover(
        bsicons::bs_icon("gear", title = "Settings"),
        selectInput(
          "var", "Select a variable",
          choices = d_vars, selected = "temp_avg"
        )
      ),
      class = "d-flex justify-content-between align-items-center"
    ),
    card_body(
      plotOutput("plot")
    ),
    full_screen = TRUE
  ),
  uiOutput("valueboxes")
)

server = function(input, output, session) {
  observe({
    updateSelectInput(
      session, "name",
      choices = d |>
        distinct(region, name) |>
        filter(region == input$region) |>
        pull(name)
    )
  })
  
  output$valueboxes = renderUI({
    clean = function(x) {
      round(x,1) |> paste("°C")
    }
    
    layout_columns(
      value_box(
        title = "Average Temp",
        value = mean(d_city()$temp_avg, na.rm=TRUE) |> clean(),
        showcase = bsicons::bs_icon("thermometer-half"),
        theme = "success"
      ),
      value_box(
        title = "Minimum Temp",
        value = min(d_city()$temp_min, na.rm=TRUE) |> clean(),
        showcase = bsicons::bs_icon("thermometer-snow"),
        theme = "primary"
      ),
      value_box(
        title = "Maximum Temp",
        value = max(d_city()$temp_max, na.rm=TRUE) |> clean(),
        showcase = bsicons::bs_icon("thermometer-sun"),
        theme = "danger"
      )
    )
  })
  
  output$title = renderText({
    names(d_vars)[d_vars==input$var]
  })
  
  d_city = reactive({
    req(input$name)
    d |>
      filter(name %in% input$name)
  })
  
  output$plot = renderPlot({
    d_city() |>
      ggplot(aes(x=date, y=.data[[input$var]])) +
      geom_line() +
      theme_minimal()
  })
}

shinyApp(ui = ui, server = server)

Dynamic UIs

Downloading

downloadButton()

downloadHandler()

Demo 06 - A download button

bindEvent()

Modal dialogs

Demo 07 - A fancy download button

Uploading

fileInput() widget

Using fileInput()

fileInput() hints

Your turn - Exercise 05

Modern UIs with bslib

Shiny & bootstrap

bslib

Cards

Styling cards

Multiple card bodies

Value boxes

Demo 08 - Shiny + bslib

Dynamic UIs

Adding value boxes

uiOutput() and renderUI()

Demo 09 - Value boxes

Demo 10 - bslib Bells and Whistles

`downloadButton()`

`downloadHandler()`

`bindEvent()`

`fileInput()` widget

Using `fileInput()`

`fileInput()` hints

`uiOutput()` and `renderUI()`