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

This is the code and output for a Spring 2020 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_full <- read_csv("./data/processed/2020-04-14-covid.csv")

Filtering Data

That dataset’s pretty robust, but let’s just take the latest numbers. The pipe %>% allows us to chain commands together.

df <- df_full %>%
  filter(new_cases_week_per_100k > 0) %>%
  filter(date == max(date))

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/>",
                     "Total confirmed cases to this date: ", confirmed_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(c("firebrick", "steelblue"), df$stay_at_home)

# 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 sqrt() on the radius to find the square root of confirmed cases per 100k people because using the raw number would make the dot too large
leaflet(df) %>%
  addTiles() %>%
  fitBounds(~min(lng), ~min(lat),
             ~max(lng), ~max(lat)) %>%
  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))

## 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 = ~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)) %>%
  addLegend("bottomright", 
            pal = pal, 
            values = ~stay_at_home,
            title = "Stay at Home Order",
            opacity = 1)

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

---

1. Data from Johns Hopkins University and Boston University↩