mapbox choropleth

Alright, let’s make some chropleths with mapdeck (mapbox+webgl).

We made a quick one in the previous dot density walkthrough, but let’s do it again with a few more styling options this time. We’ll work with the arcos opioid data so it’s similar to the leaflet-choropleths walkthrough.

The repo containing the data and scripts for this section is on Github. To follow along, simply run the lines of code below in R.


# There is no need to run these install lines below if you already have done so
install.packages("usethis")
usethis::use_course("https://github.com/andrewbtran/NICAR-2020-mapping/archive/master.zip")

# This section is in scripts/06_mapbox_choropleths.R
file.edit("scripts/06_mapbox_choropleths.R")
# This function checks if you don't have the correct packages installed yet
# If not, it will install it for you
packages <- c("sf", "tidyverse", "tigris",
              "arcos", "mapdeck")
if (length(setdiff(packages, rownames(installed.packages()))) > 0) {
  install.packages(setdiff(packages, rownames(installed.packages())), repos = "https://cran.us.r-project.org")  
}
library(sf)
library(tidyverse)
library(tigris)
library(arcos)
counties <- st_read("shapefiles/us_counties.shp")

Let’s load the mapdeck library and put in the Mapbox API key.

library(mapdeck)

Attaching package: 'mapdeck'
The following object is masked from 'package:tibble':

    add_column
mb_key <- "PutYourKeyHere"
mapdeck(token = mb_key, 
        style = mapdeck_style("light"),
        zoom=10) %>%
  add_polygon(
    data =counties,
    fill_opacity=0.1,
    stroke_colour="black",
    stroke_width=1
  )

Alright, let’s bring in some data to join with the county shapes.

#### Import data we want to map ----------------
annual_summary <- read_csv("data/county_pill_summary.csv")

Join the data.

In the leaflet walkthrough we used the geo_join() function from the tigris package, but the counties and annual_summary objects are both dataframes, so a simple left_join() from dplyr will do just fine.

counties_merged_annual <- left_join(counties, annual_summary, by=c("GEOID"="countyfips"))

counties_merged_annual <- counties_merged_annual %>% 
  filter(!is.na(avg_pills_per_person))

# Setting up the popup text
popup_sb <- paste0(counties_merged_annual$BUYER_COUNTY, ", ", counties_merged_annual$BUYER_STATE, "</br/> Average pills per person: \n", as.character(counties_merged_annual$avg_pills_per_person))

Check out the options that we can use with add_polygon().

counties_merged_annual$popup <- paste0("<strong>",counties_merged_annual$BUYER_COUNTY, "</strong><br />", counties_merged_annual$avg_pills_per_person, " pills per person per year")
mapdeck(token = mb_key, 
        style = mapdeck_style("light"),
        zoom=2,
        location=c(-98.294108,39.628777))%>% 
    add_polygon(
    data = counties_merged_annual,
    fill_colour = "avg_pills_per_person",
    fill_opacity = .9,
    auto_highlight = TRUE,
    palette = "inferno",
    tooltip = "popup",
    update_view = FALSE
  )

Let’s get crazy

Add some elevation data.

# We'll need to boost the numbers a bit so the elevation can be seen zoomed out
counties_merged_annual$elevation <- counties_merged_annual$avg_pills_per_person^2.4

mapdeck(token = mb_key, 
        style = mapdeck_style("light"),
        zoom=2,
        location=c(-98.294108,39.628777),
        pitch = 45 
        )%>% 
    add_polygon(
      data = counties_merged_annual,
      fill_colour = "avg_pills_per_person",
      fill_opacity = .9,
      auto_highlight = TRUE,
      palette = "inferno",
      tooltip = "popup",
      update_view = FALSE,
      elevation = "elevation"
    )