3  Introduction to Reactivity

Reactivity is the essential component of Shiny apps that allows them to update visualizations, filter datasets, and generate model outputs. Through reactive Shiny elements, we can avoid needing to learn JavaScript (in place of R or Python) to code these interactive web applications that were traditionally created by web developers.

As you saw in the initial introduction to Shiny, a standard app can be simplified into the user interface (UI) and the server:

library(shiny)

ui <- fluidPage(
  # what the user sees and interacts with
)

server <- function(input, output, session) {
  # back end logic for performing computations
}

shinyApp(ui, server)

To add reactivity to a Shiny app, input widgets are added to the UI for users to interact with and reactive values and/or objects are added to the server to update outputs based on the adjustments made to the inputs. Whenever an input is changed, the outputs become invalidated and all connected objects between the input and output are updated.

Below is an example of a simple Shiny app, where a slider input is used to adjust the number of bins for a histogram:

library(shiny)

ui <- fluidPage(
1  titlePanel("Old Faithful"),
  sidebarLayout(
    sidebarPanel = sidebarPanel(
2      sliderInput(inputId = "bins", label = "Number of bins:",
            min = 1, max = 50, value = 30)
    ),
    mainPanel = mainPanel(
3      plotOutput("distPlot")
    )
  )
)
1
Define title of app
2
Add an input widget
3
Place the output product 
server <- function(input, output, session) {
  
4     output$distPlot <- renderPlot({
      # generate bins based on input$bins from ui.R
      wait <- faithful[, 2] 
5      bins <- seq(min(wait), max(wait), length.out = input$bins + 1)
      
      # draw the histogram with the specified number of bins
6      hist(wait, breaks = bins, col = 'darkgray', border = 'white')
   })
     
}
4
Store output product
5
Define variable influenced by reactive input
6
Create resulting plot



We can expand on this example further by creating a reactive object after filtering a dataset based on the inputs:

library(palmerpenguins)
library(ggplot2)
library(dplyr)
library(shiny)
library(bslib)

ui <- page_sidebar(
  title = h1("Penguins dashboard"),
  
  # Define sidebar inputs
  sidebar = sidebar(
    title = strong("Histogram controls"),  #make text bold
    
1    radioButtons(inputId = "spp",
                 label = "Select a species",                                    
                 choices = unique(penguins$species)                             
    ),                                                                          
    
    #create slider input for histogram
2    sliderInput("years",
                "Select years of interest",
                min = min(penguins$year),
                max = max(penguins$year),
                value = range(penguins$year),
                step = 1,
                sep = "")
  ),
  
  # Main panel content
  h3("Exploration of Palmer penguins data"),
  
3  plotOutput("biplot")
  
)
1
Input to filter by species
2
Input to filter by year
3
Placement of the output plot 
server <- function(input, output, session) {
  
  # Create reactive object to filter based on multiple inputs
4  penguins_filt <- reactive({
    penguins |> 
      filter(year >= input$years[1] & year <= input$years[2],
             species == input$spp)
  })
  
  
  # Create biplot based on selected variables
  output$biplot <- renderPlot({
5    ggplot(penguins_filt()) +  #reactive objects need empty parentheses
      geom_point(aes(bill_length_mm, body_mass_g), color = species),
        size = 2, alpha = 0.75) +
      scale_color_brewer(palette = "Set1") +
      theme_bw(base_size = 20)
  })
}
4
Create reactive object based on filtered inputs
5
Use reactive object with standard ggplot2 code



For more information on reactivity in Shiny apps, please refer to descriptions and examples from Mastering Shiny as well as the Shiny for R tutorial.


Exercise 1

Code for Exercise 1 
library(palmerpenguins)
library(dplyr)
library(ggplot2)
library(shiny)
library(bslib)


#################
### Define UI ###
#################

ui <- page_sidebar(
  title = h1("Penguins dashboard"),
  
  # Define sidebar inputs
  sidebar = sidebar(
    title = strong("Histogram controls"),
    
    #create dropdown selection for numeric columns
    varSelectInput(
      inputId = "var",
      label = "Select variable",
      data = dplyr::select_if(penguins, is.numeric)
    ),
    
    radioButtons(inputId = "spp",
                 label = "Select a species",
                 choices = unique(penguins$species)
    ),
    
    #create slider input for histogram
    sliderInput("bins",
                "Number of bins",
                min = 3,
                max = 100,
                value = 30,
                step = 1),
    
    
    hr(),  #add horizontal line
    
    # Artwork from Allison Horst
    tags$figure(
      img(src = "https://allisonhorst.github.io/palmerpenguins/reference/figures/lter_penguins.png",
          width = "100%"),
      tags$figcaption(em("Artwork by @allison_horst"))
    )
  ),
  
  # Main panel content
  h3("Exploration of Palmer penguins data"),
  
  plotOutput("hist")
  
)



#####################
### Define server ###
#####################

server <- function(input, output, session) {
  
  # Create histogram based on selection from inputs
  output$hist <- renderPlot({
    ggplot(penguins[penguins$species == input$spp,]) +
      geom_histogram(aes(!!input$var), color = "black", fill = "cadetblue",
                     bins = input$bins) +
      theme_bw(base_size = 20)
  })
  
}


###############
### Run app ###
###############

shinyApp(ui, server)

Using the included code:

  1. Filter penguins dataset via a reactive object instead of current approach on first line of ggplot code
library(palmerpenguins)
library(dplyr)
library(ggplot2)
library(shiny)
library(bslib)


#################
### Define UI ###
#################

ui <- page_sidebar(
  title = h1("Penguins dashboard"),
  
  # Define sidebar inputs
  sidebar = sidebar(
    title = strong("Histogram controls"),
    
    #create dropdown selection for numeric columns
    varSelectInput(
      inputId = "var",
      label = "Select variable",
      data = dplyr::select_if(penguins, is.numeric)
    ),
    
    radioButtons(inputId = "spp",
                 label = "Select a species",
                 choices = unique(penguins$species)
    ),
    
    #create slider input for histogram
    sliderInput("bins",
                "Number of bins",
                min = 3,
                max = 100,
                value = 30,
                step = 1),
    
    
    hr(),  #add horizontal line
    
    # Artwork from Allison Horst
    tags$figure(
      img(src = "https://allisonhorst.github.io/palmerpenguins/reference/figures/lter_penguins.png",
          width = "100%"),
      tags$figcaption(em("Artwork by @allison_horst"))
    )
  ),
  
  # Main panel content
  h3("Exploration of Palmer penguins data"),
  
  plotOutput("hist")
  
)



#####################
### Define server ###
#####################

server <- function(input, output, session) {
  
  # Create reactive object
  penguins_filt <- reactive({
    penguins |> 
      filter(species == input$spp)
  })
  
  # Create histogram based on selection from inputs
  output$hist <- renderPlot({
    ggplot(penguins_filt()) +
      geom_histogram(aes(!!input$var), color = "black", fill = "cadetblue",
                     bins = input$bins) +
      theme_bw(base_size = 20)
  })
  
}


###############
### Run app ###
###############

shinyApp(ui, server)


Exercise 2

Code for Exercise 2 
library(palmerpenguins)
library(ggplot2)
library(shiny)
library(bslib)


#################
### Define UI ###
#################

ui <- page_sidebar(
  title = h1("Penguins dashboard"),
  
  # Define sidebar inputs
  sidebar = sidebar(
    title = strong("Histogram controls"),
    
    #create dropdown selection for numeric columns
    varSelectInput(
      inputId = "var",
      label = "Select variable",
      data = dplyr::select_if(penguins, is.numeric)
    ),
    
    radioButtons(inputId = "spp",
                 label = "Select a species",
                 choices = unique(penguins$species)
    ),
    
    #create slider input for histogram
    sliderInput("bins",
                "Number of bins",
                min = 3,
                max = 100,
                value = 30,
                step = 1),
    
    
    hr(),  #add horizontal line
    
    # Artwork from Allison Horst
    tags$figure(
      img(src = "https://allisonhorst.github.io/palmerpenguins/reference/figures/lter_penguins.png",
          width = "100%"),
      tags$figcaption(em("Artwork by @allison_horst"))
    )
  ),
  
  # Main panel content
  h3("Exploration of Palmer penguins data"),
  
  plotOutput("hist")
  
)



#####################
### Define server ###
#####################

server <- function(input, output, session) {
  
  # Create histogram based on selection from inputs
  output$hist <- renderPlot({
    ggplot(penguins[penguins$species == input$spp,]) +
      geom_histogram(aes(!!input$var), fill = "cadetblue", bins = input$bins) +
      theme_bw(base_size = 20)
  })
  
}


###############
### Run app ###
###############

shinyApp(ui, server)

Using the included code:

  1. Create reactive value for the binwidth used in histogram (by species and variable)
  2. Add binwidth to title of figure
library(palmerpenguins)
library(ggplot2)
library(shiny)
library(bslib)


#################
### Define UI ###
#################

ui <- page_sidebar(
  title = h1("Penguins dashboard"),
  
  # Define sidebar inputs
  sidebar = sidebar(
    title = strong("Histogram controls"),
    
    #create dropdown selection for numeric columns
    varSelectInput(
      inputId = "var",
      label = "Select variable",
      data = dplyr::select_if(penguins, is.numeric)
    ),
    
    radioButtons(inputId = "spp",
                 label = "Select a species",
                 choices = unique(penguins$species)
    ),
    
    #create slider input for histogram
    sliderInput("bins",
                "Number of bins",
                min = 3,
                max = 100,
                value = 30,
                step = 1),
    
    
    hr(),  #add horizontal line
    
    # Artwork from Allison Horst
    tags$figure(
      img(src = "https://allisonhorst.github.io/palmerpenguins/reference/figures/lter_penguins.png",
          width = "100%"),
      tags$figcaption(em("Artwork by @allison_horst"))
    )
  ),
  
  # Main panel content
  h3("Exploration of Palmer penguins data"),
  
  plotOutput("hist")
  
)



#####################
### Define server ###
#####################

server <- function(input, output, session) {
  
  # Create reactive value for sample size of dataset
  r <- reactiveValues(binwidth = 0)
  
  # Update reactiveValue for sample size based on penguins_filt
  observe({
    req(input$bins)  #ensure/require that reactive object is available before proceeding
    
    # Define min and max values for selected variable by species
    min_var <- min(penguins[penguins$species == input$spp, input$var], na.rm = TRUE)
    max_var <- max(penguins[penguins$species == input$spp, input$var], na.rm = TRUE)
    r$binwidth <- round((max_var - min_var) / input$bins, 3)  #update reactive value
  })
  
  # Create histogram based on selection from inputs
  output$hist <- renderPlot({
    ggplot(penguins[penguins$species == input$spp,]) +
      geom_histogram(aes(!!input$var), fill = "cadetblue", bins = input$bins) +
      labs(title = paste("Histogram binwidth is", r$binwidth)) +  #reactive value used in title
      theme_bw(base_size = 20)
  })
  
}


###############
### Run app ###
###############

shinyApp(ui, server)