Basic Shiny App Structure

Let’s start off by creating a new Shiny application. We could do this by using the “Shiny Web App…” option under the new files menu and choosing “Single File.” You can do that as an example if you like, but we’ll eventually be creating one from scratch. For reference, this is what the default Shiny app looks like:

This is divided into two principal components:

  • UI (user interface):
    • a web page displaying information
  • Server:
    • A computer running a live R session
  • Call to run the application

User Interface

The user interface is what it sounds like - the user-facing side of your application. It’s all contained in a fluidPage wrapper, and is made up of various display elements. These are mainly the titlePanel, sidebarPanel (with a sliderInput), and the mainPanel (which contains a plotOutput). Here it is on its own:

These are just a few of the UI elements available to you. You can see more about layouts and UI elements here.

Server

The server is where the processing and updating of data, plots, etc. happens. Most of the R code that you’ve used already will happen here. This is what it looks like in the default application:

This code is where the data is filtered and plot is created.

Logical Flow

You can see the result of the renderPlot function is saved into an output called distPlot. This is mirrored in the output("distPlot") in the UI side, where the plot is displayed. You can also see that the server contains input$bins, which is a reference to sliderInput("bins", ...) in the UI. Inputs and outputs are special objects in Shiny that allow the UI and server to communicate with one another and create interactivity. The input on the UI side accepts information which is processed in the server. The server creates changes to the plot in response to that information, and the plot is then displayed again on the UI side.

The general flow looks like this:

  • UI accepts interaction from user at input
  • Server processes new information from input and saves results to output
  • UI displays updated output

Call to Run

The final line of the default app is the call to run the application. It tells R to link and start the UI and server, and looks like this:

Beginning Our Application

We’re going to start our application with the same overall structure, but let’s not include any of the other elements we don’t need from the default app. We’ll need a basic structure, along with a couple of preliminary elements (like calls to packages we’ll want).

Adding Static Elements

There are a few other things that won’t change within our application. The first is our original dataset (which will contain all of our data, unfiltered), and the second is the color palette we’ll be creating. Let’s add those in.

Creating the UI

Now that we’ve got a basic (but still empty) application, let’s add some UI elements to provide us with something to look at. We can start with the basic structure by adding things like the title and some rows and columns to organize our UI

Our page is going to be made up of three fluidRow() elements, which organize the page horizontally. For aesthetic’s sake, we’re going to separate those rows with horizontal rules hr().

Adding content

If you run this application now, it won’t look much different, but we’ve just completed the underlying structure for our UI! Now we can add some content. Let’s start off with our data attribution - citing our sources is important!

Starting Point

This takes us up to the content that we have in starting-app.R, which was available to download from our Canvas site. This is where you can start adding code in yourself.

Working with reactive data

Now let’s add in our main panel with our map.

Click on the Code button to see how that looks in the context of our application.

Creating reactive data

Hmm…we’ve added a place for the map on our UI, but nothing’s happening yet. That’s because we need to put some code on our server that will create the map. This comes in two steps. The first is to filter our dataset to a specific day, and the next is to create a map with it. We’ll filter our data and save it as a reactive(), which is a type of object that Shiny knows will change whenever new data is sent from the inputs.

Right now we’re going to stick with the latest date, but we’ll change it later on so that we can use an input to select the date.

Click on the Code button to see how that looks in the context of our application.

Adding our map using an output

Now that we’ve added our data as a reactive(), let’s go ahead and use it to make our map. This will happen in two parts. The first is going to be setting up our empty map and legend using our bounds, the second is going to be adding our markers. The first part will be wrapped in a renderLeaflet() function, which is one of the ways we tell Shiny that something will react to inputs. There are other renderX functions, e.g. renderPlot(), renderText(), renderTable(). Here’s how we add the empty map:

Click on the Code button to see how that looks in the context of our application.

Using leafletProxy() for markers

Because there are a lot of markers and we plan to update them frequently, we’ll be using leafletProxy() to only change our markers without having to reload the entire map every time something changes. You can read more about leafletProxy here. We’re going to put it inside of an observe(), which will look for changes from our inputs and re-run the code inside any time something changes.

Click on the Code button to see how that looks in the context of our application.

library(tidyverse)
library(shiny)
library(leaflet)

df_original <- read_csv("./data/processed/2020-04-14-covid.csv")
pal <- colorFactor(c("firebrick", "steelblue"), c(FALSE, TRUE))
lng1 <- -125
lat1 <- 25
lng2 <- -68
lat2 <- 49

# UI --------------------
ui <- fluidPage(
  title = "Tracking the Spread of COVID-19",
  titlePanel("Tracking the Spread of COVID-19 by County"),
  fluidRow(
    column(12,
           mainPanel(leafletOutput("map"))
    )
  ),
  hr(),
  fluidRow(
    column(4),
    column(4),
    column(4)
  ),
  hr(),
  fluidRow(
    column(12,
           p("Data from ", 
             a("Johns Hopkins", 
               href = "https://github.com/CSSEGISandData/COVID-19", 
               target = "_blank"),
             " and ", 
             a("Boston University", 
               href = "https://docs.google.com/spreadsheets/d/1zu9qEWI8PsOI_i8nI_S29HDGHlIp2lfVMsGxpQ5tvAQ/edit?usp=sharing", 
               target = "_blank"))
    )
  )
)

# Server --------------------
server <- function(input, output) {
  
  df <- reactive({
    # This is the same code we used to filter to the latest date in last week's lesson!
    tmp <- df_original %>%
      filter(new_cases_week_per_100k > 0) %>%
      filter(date == max(date))
    
    return(tmp)
  })
  
  output$map <- renderLeaflet({
    
    leaflet() %>%
      addTiles() %>%
      fitBounds(lng1, lat1, lng2, lat2) %>%
      addLegend("bottomright", 
                pal = pal, 
                values = c(FALSE, TRUE),
                title = "Stay at Home Order",
                opacity = 1)
    
    
  })
  
  observe({
    
    leafletProxy("map", data = df()) %>%
      clearMarkers() %>%
      # This is our same code to create markers from last week!
      addCircleMarkers(radius = ~sqrt(confirmed_cases_per_100k),
                       stroke = FALSE,
                       fillOpacity = 0.5,
                       color = ~pal(stay_at_home),
                       popup = ~paste0("<b>", region, "</b><br/>",
                                       "Total confirmed cases to this date: ", confirmed_cases, "<br/>",
                                       "Per 100k people: ", confirmed_cases_per_100k, "<br/><br/>",
                                       "Total confirmed deaths to this date: ", deaths, "<br/>",
                                       "Per 100k people: ", deaths_per_100k, "<br/><br/>",
                                       "Cases in the preceding week: ", new_cases_week, "<br/>",
                                       "Per 100k people: ", new_cases_week_per_100k, "<br/><br/>",
                                       "Deaths in the preceding week: ", new_deaths_week, "<br/>",
                                       "Per 100k people: ", new_deaths_week_per_100k, "<br/><br/>",
                                       "Stay at home in place on this date: ", stay_at_home))
  })
  
}

shinyApp(ui = ui, server = server)

Excellent! Now we’ve got our map from last time! Time to make it even better!

Adding Inputs

Let’s add some inputs to our UI and see how they connect to our server.

Date Filter (UI)

In the first column() of our second fluidRow(), we can add in a date filter. We’ll do that by adding a sliderInput() to the first column() of our second fluidRow(). We have to define things like the range and beginning value of our slider. We’re also going to set animate = TRUE to add a play/pause button.

Click on the Code button to see how that looks in the context of our application.

library(tidyverse)
library(shiny)
library(leaflet)

df_original <- read_csv("./data/processed/2020-04-14-covid.csv")
pal <- colorFactor(c("firebrick", "steelblue"), c(FALSE, TRUE))
lng1 <- -125
lat1 <- 25
lng2 <- -68
lat2 <- 49

# UI --------------------
ui <- fluidPage(
  title = "Tracking the Spread of COVID-19",
  titlePanel("Tracking the Spread of COVID-19 by County"),
  fluidRow(
    column(12,
           mainPanel(leafletOutput("map"))
    )
  ),
  hr(),
  fluidRow(
    column(4,        
           sliderInput("date_select", 
                       "Select Mapping Date",
                       min = min(df_original$date),
                       max = max(df_original$date),
                       value = max(df_original$date),
                       animate = TRUE)
    ),
    column(4),
    column(4)
  ),
  hr(),
  fluidRow(
    column(12,
           p("Data from ", 
             a("Johns Hopkins", 
               href = "https://github.com/CSSEGISandData/COVID-19", 
               target = "_blank"),
             " and ", 
             a("Boston University", 
               href = "https://docs.google.com/spreadsheets/d/1zu9qEWI8PsOI_i8nI_S29HDGHlIp2lfVMsGxpQ5tvAQ/edit?usp=sharing", 
               target = "_blank"))
    )
  )
)

# Server --------------------
server <- function(input, output) {
  
  df <- reactive({
    # This is the same code we used to filter to the latest date in last week's lesson!
    tmp <- df_original %>%
      filter(new_cases_week_per_100k > 0) %>%
      filter(date == max(date))
    
    return(tmp)
  })
  
  output$map <- renderLeaflet({
    
    leaflet() %>%
      addTiles() %>%
      fitBounds(lng1, lat1, lng2, lat2) %>%
      addLegend("bottomright", 
                pal = pal, 
                values = c(FALSE, TRUE),
                title = "Stay at Home Order",
                opacity = 1)
    
    
  })
  
  observe({
    
    leafletProxy("map", data = df()) %>%
      clearMarkers() %>%
      # This is our same code to create markers from last week!
      addCircleMarkers(radius = ~sqrt(confirmed_cases_per_100k),
                       stroke = FALSE,
                       fillOpacity = 0.5,
                       color = ~pal(stay_at_home),
                       popup = ~paste0("<b>", region, "</b><br/>",
                                       "Total confirmed cases to this date: ", confirmed_cases, "<br/>",
                                       "Per 100k people: ", confirmed_cases_per_100k, "<br/><br/>",
                                       "Total confirmed deaths to this date: ", deaths, "<br/>",
                                       "Per 100k people: ", deaths_per_100k, "<br/><br/>",
                                       "Cases in the preceding week: ", new_cases_week, "<br/>",
                                       "Per 100k people: ", new_cases_week_per_100k, "<br/><br/>",
                                       "Deaths in the preceding week: ", new_deaths_week, "<br/>",
                                       "Per 100k people: ", new_deaths_week_per_100k, "<br/><br/>",
                                       "Stay at home in place on this date: ", stay_at_home))
  })
  
}

shinyApp(ui = ui, server = server)

Date Filter (Server)

This is great, but it isn’t hooked up to anything yet. This input allows us to select a date within the range that’s in our dataset, but we need to filter the data to the correct date before we can display it. Let’s add the code to handle that to our server side in our reactive(). Rather than filtering for the last date using filter(date == max(date)), we’re going to reference our input using filter(date == input$date_select).

Click on the Code button to see how that looks in the context of our application.

library(tidyverse)
library(shiny)
library(leaflet)

df_original <- read_csv("./data/processed/2020-04-14-covid.csv")
pal <- colorFactor(c("firebrick", "steelblue"), c(FALSE, TRUE))
lng1 <- -125
lat1 <- 25
lng2 <- -68
lat2 <- 49

# UI --------------------
ui <- fluidPage(
  title = "Tracking the Spread of COVID-19",
  titlePanel("Tracking the Spread of COVID-19 by County"),
  fluidRow(
    column(12,
           mainPanel(leafletOutput("map"))
    )
  ),
  hr(),
  fluidRow(
    column(4,        
           sliderInput("date_select", 
                       "Select Mapping Date",
                       min = min(df_original$date),
                       max = max(df_original$date),
                       value = max(df_original$date),
                       animate = TRUE)
    ),
    column(4),
    column(4)
  ),
  hr(),
  fluidRow(
    column(12,
           p("Data from ", 
             a("Johns Hopkins", 
               href = "https://github.com/CSSEGISandData/COVID-19", 
               target = "_blank"),
             " and ", 
             a("Boston University", 
               href = "https://docs.google.com/spreadsheets/d/1zu9qEWI8PsOI_i8nI_S29HDGHlIp2lfVMsGxpQ5tvAQ/edit?usp=sharing", 
               target = "_blank"))
    )
  )
)

# Server --------------------
server <- function(input, output) {
  
  df <- reactive({
    tmp <- df_original %>%
      filter(new_cases_week_per_100k > 0) %>%
      filter(date == input$date_select)
    
    return(tmp)
  })
  
  output$map <- renderLeaflet({
    
    leaflet() %>%
      addTiles() %>%
      fitBounds(lng1, lat1, lng2, lat2) %>%
      addLegend("bottomright", 
                pal = pal, 
                values = c(FALSE, TRUE),
                title = "Stay at Home Order",
                opacity = 1)
    
    
  })
  
  observe({
    
    leafletProxy("map", data = df()) %>%
      clearMarkers() %>%
      # This is our same code to create markers from last week!
      addCircleMarkers(radius = ~sqrt(confirmed_cases_per_100k),
                       stroke = FALSE,
                       fillOpacity = 0.5,
                       color = ~pal(stay_at_home),
                       popup = ~paste0("<b>", region, "</b><br/>",
                                       "Total confirmed cases to this date: ", confirmed_cases, "<br/>",
                                       "Per 100k people: ", confirmed_cases_per_100k, "<br/><br/>",
                                       "Total confirmed deaths to this date: ", deaths, "<br/>",
                                       "Per 100k people: ", deaths_per_100k, "<br/><br/>",
                                       "Cases in the preceding week: ", new_cases_week, "<br/>",
                                       "Per 100k people: ", new_cases_week_per_100k, "<br/><br/>",
                                       "Deaths in the preceding week: ", new_deaths_week, "<br/>",
                                       "Per 100k people: ", new_deaths_week_per_100k, "<br/><br/>",
                                       "Stay at home in place on this date: ", stay_at_home))
  })
  
}

shinyApp(ui = ui, server = server)

Now try running that code - you should be able to animate the map using the date slider we’ve created.

Policy Filter (UI)

Let’s try using another type of widget to control our map. By default, we’re coloring our bubbles using the “stay_at_home” policy variable. We might also be interested in others, though, so let’s give ourselves the option to explore that. First we need to add elements to our UI - this time we’ll use a radioButtons() input, which will go in the second column() of our second fluidRow(). For the radioButtons(), we will provide a list of choices. The text displayed in the UI will appear on the left, and the variable name we’re referencing will appear on the right, e.g. "Stay At Home Order" = "stay_at_home".

Click on the Code button to see how that looks in the context of our application.

library(tidyverse)
library(shiny)
library(leaflet)

df_original <- read_csv("./data/processed/2020-04-14-covid.csv")
pal <- colorFactor(c("firebrick", "steelblue"), c(FALSE, TRUE))
lng1 <- -125
lat1 <- 25
lng2 <- -68
lat2 <- 49

# UI --------------------
ui <- fluidPage(
  title = "Tracking the Spread of COVID-19",
  titlePanel("Tracking the Spread of COVID-19 by County"),
  fluidRow(
    column(12,
           mainPanel(leafletOutput("map"))
    )
  ),
  hr(),
  fluidRow(
    column(4,        
           sliderInput("date_select", 
                       "Select Mapping Date",
                       min = min(df_original$date),
                       max = max(df_original$date),
                       value = max(df_original$date),
                       animate = TRUE)
    ),
    column(4,
           radioButtons("color_by",
                        "Color Markers By Policy",
                        choices = list("Stay At Home Order" = "stay_at_home",
                                       "State of Emergency" = "state_of_emergency",
                                       "K-12 Schools Closed" = "schools_closed",
                                       "Non-essential Businesses Closed" = "non_essentials_closed"))
    ),
    column(4)
  ),
  hr(),
  fluidRow(
    column(12,
           p("Data from ", 
             a("Johns Hopkins", 
               href = "https://github.com/CSSEGISandData/COVID-19", 
               target = "_blank"),
             " and ", 
             a("Boston University", 
               href = "https://docs.google.com/spreadsheets/d/1zu9qEWI8PsOI_i8nI_S29HDGHlIp2lfVMsGxpQ5tvAQ/edit?usp=sharing", 
               target = "_blank"))
    )
  )
)

# Server --------------------
server <- function(input, output) {
  
  df <- reactive({
    # This is the same code we used to filter to the latest date in last week's lesson!
    tmp <- df_original %>%
      filter(new_cases_week_per_100k > 0) %>%
      filter(date == input$date_select)
    
    return(tmp)
  })
  
  output$map <- renderLeaflet({
    
    leaflet() %>%
      addTiles() %>%
      fitBounds(lng1, lat1, lng2, lat2) %>%
      addLegend("bottomright", 
                pal = pal, 
                values = c(FALSE, TRUE),
                title = "Stay at Home Order",
                opacity = 1)
    
    
  })
  
  observe({
    
    leafletProxy("map", data = df()) %>%
      clearMarkers() %>%
      # This is our same code to create markers from last week!
      addCircleMarkers(radius = ~sqrt(confirmed_cases_per_100k),
                       stroke = FALSE,
                       fillOpacity = 0.5,
                       color = ~pal(stay_at_home),
                       popup = ~paste0("<b>", region, "</b><br/>",
                                       "Total confirmed cases to this date: ", confirmed_cases, "<br/>",
                                       "Per 100k people: ", confirmed_cases_per_100k, "<br/><br/>",
                                       "Total confirmed deaths to this date: ", deaths, "<br/>",
                                       "Per 100k people: ", deaths_per_100k, "<br/><br/>",
                                       "Cases in the preceding week: ", new_cases_week, "<br/>",
                                       "Per 100k people: ", new_cases_week_per_100k, "<br/><br/>",
                                       "Deaths in the preceding week: ", new_deaths_week, "<br/>",
                                       "Per 100k people: ", new_deaths_week_per_100k, "<br/><br/>",
                                       "Stay at home in place on this date: ", stay_at_home))
  })
  
}

shinyApp(ui = ui, server = server)

Policy Filter (Server)

If we run the app now, we’ll have the widget on our UI. It’s not hooked up to anything in our server yet, though, so that’s the next step. We’ll need to change it in two places: when we’re creating our legend, and when we’re creating our circle markers. Because we’re referencing a variable name in the code to color the markers, we need to use the get() function around input$color_by; this tells Shiny to read the input as a variable stay_at_home rather than as just a character string "stay_at_home".

Click on the Code button to see how that looks in the context of our application.

library(tidyverse)
library(shiny)
library(leaflet)

df_original <- read_csv("./data/processed/2020-04-14-covid.csv")
pal <- colorFactor(c("firebrick", "steelblue"), c(FALSE, TRUE))
lng1 <- -125
lat1 <- 25
lng2 <- -68
lat2 <- 49

# UI --------------------
ui <- fluidPage(
  title = "Tracking the Spread of COVID-19",
  titlePanel("Tracking the Spread of COVID-19 by County"),
  fluidRow(
    column(12,
           mainPanel(leafletOutput("map"))
    )
  ),
  hr(),
  fluidRow(
    column(4,        
           sliderInput("date_select", 
                       "Select Mapping Date",
                       min = min(df_original$date),
                       max = max(df_original$date),
                       value = max(df_original$date),
                       animate = TRUE)
    ),
    column(4,
           radioButtons("color_by",
                        "Color Markers By Policy",
                        choices = list("Stay At Home Order" = "stay_at_home",
                                       "State of Emergency" = "state_of_emergency",
                                       "K-12 Schools Closed" = "schools_closed",
                                       "Non-essential Businesses Closed" = "non_essentials_closed"))
    ),
    column(4)
  ),
  hr(),
  fluidRow(
    column(12,
           p("Data from ", 
             a("Johns Hopkins", 
               href = "https://github.com/CSSEGISandData/COVID-19", 
               target = "_blank"),
             " and ", 
             a("Boston University", 
               href = "https://docs.google.com/spreadsheets/d/1zu9qEWI8PsOI_i8nI_S29HDGHlIp2lfVMsGxpQ5tvAQ/edit?usp=sharing", 
               target = "_blank"))
    )
  )
)

# Server --------------------
server <- function(input, output) {
  
  df <- reactive({
    # This is the same code we used to filter to the latest date in last week's lesson!
    tmp <- df_original %>%
      filter(new_cases_week_per_100k > 0) %>%
      filter(date == input$date_select)
    
    return(tmp)
  })
  
  output$map <- renderLeaflet({
    
    leaflet() %>%
      addTiles() %>%
      fitBounds(lng1, lat1, lng2, lat2) %>%
      addLegend("bottomright", 
                pal = pal, 
                values = c(FALSE, TRUE),
                title = input$color_by,
                opacity = 1)
    
    
  })
  
  observe({
    
    leafletProxy("map", data = df()) %>%
      clearMarkers() %>%
      addCircleMarkers(radius = ~sqrt(confirmed_cases_per_100k),
                       stroke = FALSE,
                       fillOpacity = 0.5,
                       color = ~pal(get(input$color_by)),
                       popup = ~paste0("<b>", region, "</b><br/>",
                                       "Total confirmed cases to this date: ", confirmed_cases, "<br/>",
                                       "Per 100k people: ", confirmed_cases_per_100k, "<br/><br/>",
                                       "Total confirmed deaths to this date: ", deaths, "<br/>",
                                       "Per 100k people: ", deaths_per_100k, "<br/><br/>",
                                       "Cases in the preceding week: ", new_cases_week, "<br/>",
                                       "Per 100k people: ", new_cases_week_per_100k, "<br/><br/>",
                                       "Deaths in the preceding week: ", new_deaths_week, "<br/>",
                                       "Per 100k people: ", new_deaths_week_per_100k, "<br/><br/>",
                                       "Stay at home in place on this date: ", stay_at_home))
  })
  
}

shinyApp(ui = ui, server = server)

Activity

Here’s what we’ve included on the UI side to allow us to select which variable determines our markers’ sizes. The UI side alone doesn’t do anything yet, though. Take a few minutes in your breakout rooms to talk over what you’d need to include in the server side of our application to allow us to size markers based on this input.

Application with UI-side code

Click on the Code button to see how that looks in the context of our application.

library(tidyverse)
library(shiny)
library(leaflet)

df_original <- read_csv("./data/processed/2020-04-14-covid.csv")
pal <- colorFactor(c("firebrick", "steelblue"), c(FALSE, TRUE))
lng1 <- -125
lat1 <- 25
lng2 <- -68
lat2 <- 49

# UI --------------------
ui <- fluidPage(
  title = "Tracking the Spread of COVID-19",
  titlePanel("Tracking the Spread of COVID-19 by County"),
  fluidRow(
    column(12,
           mainPanel(leafletOutput("map"))
    )
  ),
  hr(),
  fluidRow(
    column(4,        
           sliderInput("date_select", 
                       "Select Mapping Date",
                       min = min(df_original$date),
                       max = max(df_original$date),
                       value = max(df_original$date),
                       animate = TRUE)
    ),
    column(4,
           radioButtons("color_by",
                        "Color Markers By Policy",
                        choices = list("Stay At Home Order" = "stay_at_home",
                                       "State of Emergency" = "state_of_emergency",
                                       "K-12 Schools Closed" = "schools_closed",
                                       "Non-essential Businesses Closed" = "non_essentials_closed"))
    ),
    column(4,
           radioButtons("size_by",
                        "Size Markers By Value",
                        choices = list("Total Confirmed Cases" = "confirmed_cases",
                                       "Total Confirmed Cases per 100k People" = "confirmed_cases_per_100k",
                                       "New Cases in Last Week" = "new_cases_week",
                                       "New Cases in Last Week per 100k People" = "new_cases_week_per_100k",
                                       "Total Deaths" = "deaths",
                                       "Deaths per 100k People" = "deaths_per_100k",
                                       "Deaths in Last Week" = "new_deaths_week",
                                       "Deaths in Last Week per 100k People" = "new_deaths_week_per_100k"), 
                        selected = "new_cases_week_per_100k")
    )
  ),
  hr(),
  fluidRow(
    column(12,
           p("Data from ", 
             a("Johns Hopkins", 
               href = "https://github.com/CSSEGISandData/COVID-19", 
               target = "_blank"),
             " and ", 
             a("Boston University", 
               href = "https://docs.google.com/spreadsheets/d/1zu9qEWI8PsOI_i8nI_S29HDGHlIp2lfVMsGxpQ5tvAQ/edit?usp=sharing", 
               target = "_blank"))
    )
  )
)

# Server --------------------
server <- function(input, output) {
  
  df <- reactive({
    # This is the same code we used to filter to the latest date in last week's lesson!
    tmp <- df_original %>%
      filter(new_cases_week_per_100k > 0) %>%
      filter(date == input$date_select)
    
    return(tmp)
  })
  
  output$map <- renderLeaflet({
    
    leaflet() %>%
      addTiles() %>%
      fitBounds(lng1, lat1, lng2, lat2) %>%
      addLegend("bottomright", 
                pal = pal, 
                values = c(FALSE, TRUE),
                title = input$color_by,
                opacity = 1)
    
    
  })
  
  observe({
    
    leafletProxy("map", data = df()) %>%
      clearMarkers() %>%
      addCircleMarkers(radius = ~sqrt(confirmed_cases_per_100k),
                       stroke = FALSE,
                       fillOpacity = 0.5,
                       color = ~pal(get(input$color_by)),
                       popup = ~paste0("<b>", region, "</b><br/>",
                                       "Total confirmed cases to this date: ", confirmed_cases, "<br/>",
                                       "Per 100k people: ", confirmed_cases_per_100k, "<br/><br/>",
                                       "Total confirmed deaths to this date: ", deaths, "<br/>",
                                       "Per 100k people: ", deaths_per_100k, "<br/><br/>",
                                       "Cases in the preceding week: ", new_cases_week, "<br/>",
                                       "Per 100k people: ", new_cases_week_per_100k, "<br/><br/>",
                                       "Deaths in the preceding week: ", new_deaths_week, "<br/>",
                                       "Per 100k people: ", new_deaths_week_per_100k, "<br/><br/>",
                                       "Stay at home in place on this date: ", stay_at_home))
  })
  
}

shinyApp(ui = ui, server = server)

Answer

Here’s what you’d need to change on the server side to allow users to choose how they size their markers.

Answer (complete application)

You can view the complete application with the answer here

library(tidyverse)
library(shiny)
library(leaflet)

df_original <- read_csv("./data/processed/2020-04-14-covid.csv")
pal <- colorFactor(c("firebrick", "steelblue"), c(FALSE, TRUE))
lng1 <- -125
lat1 <- 25
lng2 <- -68
lat2 <- 49

# UI --------------------
ui <- fluidPage(
  title = "Tracking the Spread of COVID-19",
  titlePanel("Tracking the Spread of COVID-19 by County"),
  fluidRow(
    column(12,
           mainPanel(leafletOutput("map"))
    )
  ),
  hr(),
  fluidRow(
    column(4,        
           sliderInput("date_select", 
                       "Select Mapping Date",
                       min = min(df_original$date),
                       max = max(df_original$date),
                       value = max(df_original$date),
                       animate = TRUE)
    ),
    column(4,
           radioButtons("color_by",
                        "Color Markers By Policy",
                        choices = list("Stay At Home Order" = "stay_at_home",
                                       "State of Emergency" = "state_of_emergency",
                                       "K-12 Schools Closed" = "schools_closed",
                                       "Non-essential Businesses Closed" = "non_essentials_closed"))
    ),
    column(4,
           radioButtons("size_by",
                        "Size Markers By Value",
                        choices = list("Total Confirmed Cases" = "confirmed_cases",
                                       "Total Confirmed Cases per 100k People" = "confirmed_cases_per_100k",
                                       "New Cases in Last Week" = "new_cases_week",
                                       "New Cases in Last Week per 100k People" = "new_cases_week_per_100k",
                                       "Total Deaths" = "deaths",
                                       "Deaths per 100k People" = "deaths_per_100k",
                                       "Deaths in Last Week" = "new_deaths_week",
                                       "Deaths in Last Week per 100k People" = "new_deaths_week_per_100k"), 
                        selected = "new_cases_week_per_100k")
    )
  ),
  hr(),
  fluidRow(
    column(12,
           p("Data from ", 
             a("Johns Hopkins", 
               href = "https://github.com/CSSEGISandData/COVID-19", 
               target = "_blank"),
             " and ", 
             a("Boston University", 
               href = "https://docs.google.com/spreadsheets/d/1zu9qEWI8PsOI_i8nI_S29HDGHlIp2lfVMsGxpQ5tvAQ/edit?usp=sharing", 
               target = "_blank"))
    )
  )
)

# Server --------------------
server <- function(input, output) {
  
  df <- reactive({
    # This is the same code we used to filter to the latest date in last week's lesson!
    tmp <- df_original %>%
      filter(new_cases_week_per_100k > 0) %>%
      filter(date == input$date_select)
    
    return(tmp)
  })
  
  output$map <- renderLeaflet({
    
    leaflet() %>%
      addTiles() %>%
      fitBounds(lng1, lat1, lng2, lat2) %>%
      addLegend("bottomright", 
                pal = pal, 
                values = c(FALSE, TRUE),
                title = input$color_by,
                opacity = 1)
    
    
  })
  
  observe({
    
    leafletProxy("map", data = df()) %>%
      clearMarkers() %>%
      addCircleMarkers(radius = ~sqrt(get(input$size_by)),
                       stroke = FALSE,
                       fillOpacity = 0.5,
                       color = ~pal(get(input$color_by)),
                       popup = ~paste0("<b>", region, "</b><br/>",
                                       "Total confirmed cases to this date: ", confirmed_cases, "<br/>",
                                       "Per 100k people: ", confirmed_cases_per_100k, "<br/><br/>",
                                       "Total confirmed deaths to this date: ", deaths, "<br/>",
                                       "Per 100k people: ", deaths_per_100k, "<br/><br/>",
                                       "Cases in the preceding week: ", new_cases_week, "<br/>",
                                       "Per 100k people: ", new_cases_week_per_100k, "<br/><br/>",
                                       "Deaths in the preceding week: ", new_deaths_week, "<br/>",
                                       "Per 100k people: ", new_deaths_week_per_100k, "<br/><br/>",
                                       "Stay at home in place on this date: ", stay_at_home))
  })
  
}

shinyApp(ui = ui, server = server)