Using R/Leaflet to Map the Spread of COVID-19

This is the code and output for a Spring 2021 instruction session on how to use the leaflet R package to create interactive maps.

Load Packages

# Load in packages
library(tidyverse)
library(leaflet)

Leaflet

# Take a look at Leaflet
leaflet()

# Boring without tiles, so let's add a base layer
leaflet() %>%
  addTiles()

# We could try provider tiles, using list from: http://leaflet-extras.github.io/leaflet-providers/preview/index.html
leaflet() %>%
  addProviderTiles(providers$Stamen.Toner)

leaflet() %>%
  addProviderTiles(providers$Esri.WorldTerrain)

# Try stacking them up:
leaflet() %>%
  addProviderTiles(providers$Esri.WorldShadedRelief) %>%
  addProviderTiles(providers$Stamen.TonerLabels)

Load in data¹

# Let's try adding markers
# Retrieve full COVID dataset
df <- read_csv("./data/processed/recent_cases.csv")

Fit the map to bounds

Let’s add in a line that will fit the map to our min and max latitude and longitude.

leaflet(df) %>%
  addTiles() %>%
  fitBounds(~min(lng), ~min(lat),
             ~max(lng), ~max(lat))

Adding Markers

# Let's try using circle markers
leaflet(df) %>%
  addTiles() %>%
  fitBounds(~min(lng), ~min(lat),
             ~max(lng), ~max(lat)) %>%
  addCircleMarkers()

## Assuming "lng" and "lat" are longitude and latitude, respectively

# We can now customize those markers to look better
leaflet(df) %>%
  addTiles() %>%
  fitBounds(~min(lng), ~min(lat),
             ~max(lng), ~max(lat)) %>%
  addCircleMarkers(stroke = FALSE)

## Assuming "lng" and "lat" are longitude and latitude, respectively

leaflet(df) %>%
  addTiles() %>%
  fitBounds(~min(lng), ~min(lat),
             ~max(lng), ~max(lat)) %>%
  addCircleMarkers(stroke = FALSE,
                   fillOpacity = 0.5,
                   fillColor = "steelblue")

## Assuming "lng" and "lat" are longitude and latitude, respectively

Adding popups

# Now that we've customized markers a little, let's try adding a popup!
leaflet(df) %>%
  addTiles() %>%
  fitBounds(~min(lng), ~min(lat),
            ~max(lng), ~max(lat)) %>%
  addCircleMarkers(stroke = FALSE,
                   fillOpacity = 0.5,
                   fillColor = "steelblue",
                   radius = 5,
                   popup = "Hello!"
  )

## Assuming "lng" and "lat" are longitude and latitude, respectively

# Better to use actual data for popup content
leaflet(df) %>%
  addTiles() %>%
  fitBounds(~min(lng), ~min(lat),
            ~max(lng), ~max(lat)) %>%
  addCircleMarkers(stroke = FALSE,
                   fillOpacity = 0.5,
                   fillColor = "steelblue",
                   radius = 5,
                   popup = ~paste0(
                     "<b>", region, "</b><br/>",
                     "Number of Cases: ", cases
                   )
  )

## Assuming "lng" and "lat" are longitude and latitude, respectively

Adding finishing touches

# We can use data to color the dots, as well - first things first, let's get a color palette
pal <- colorFactor("Set1", df$largest_age_group)

# We'll use data to color the dots, set the size of the dot, and populate the popup (using html)
# We're going to use log() on the radius because the raw number of cases would be too large
leaflet(df) %>%
  addTiles() %>%
  fitBounds(~min(lng), ~min(lat),
             ~max(lng), ~max(lat)) %>%
  addCircleMarkers(radius = ~log(cases),
                   stroke = FALSE,
                   fillOpacity = 0.5,
                   color = ~pal(largest_age_group),
                   popup = ~paste0(
                     "<b>", region, "</b><br/>",
                     "Number of Cases: ", cases, "</br>",
                     "Lab-confirmed Cases: ", lab_n, "</br>",
                     "Number of Deaths: ", death_n, "</br>",
                     "Largest Age Group: ", largest_age_group
                   ))

## Assuming "lng" and "lat" are longitude and latitude, respectively

# Now we'll add a legend
leaflet(df) %>%
  addTiles() %>%
  fitBounds(~min(lng), ~min(lat),
             ~max(lng), ~max(lat)) %>%
  addCircleMarkers(radius = ~log(cases),
                   stroke = FALSE,
                   fillOpacity = 0.5,
                   color = ~pal(largest_age_group),
                   popup = ~paste0(
                     "<b>", region, "</b><br/>",
                     "Number of Cases: ", cases, "</br>",
                     "Lab-confirmed Cases: ", lab_n, "</br>",
                     "Number of Deaths: ", death_n, "</br>",
                     "Largest Age Group: ", largest_age_group
                   )) %>%
  addLegend("bottomright", 
            pal = pal, 
            values = ~unique(largest_age_group),
            title = "Largest Age Group",
            opacity = 1)

## Assuming "lng" and "lat" are longitude and latitude, respectively

---

1. Data from CDC↩︎