March 21, 2020

Mapping COVID-19 in Oregon

Oregon COVID data

The Oregon data are available from OHA here. I cut and pasted the first two days because it was easy with datapasta. As it goes on, it was easier to write a script that I detail elsewhere that I can self-update.

urbnmapr

The Urban Institute has an excellent state and county mapping package. I want to make use of the county-level data and plot the starter map.

devtools::install_github("UrbanInstitute/urbnmapr")
Counties.SF <- get_urbn_map("counties", sf=TRUE)
ggplot(Counties.SF) + geom_sf()

I want to use it to map Oregon counties. First, I need to identify Oregon counties and the case for Oregon. Filter those and plot them.

library(janitor)
Counties.SF %>% tabyl(state_name) %>% head()
##  state_namegeometry  n     percent
##             Alabama 67 0.021323997
##              Alaska 29 0.009229790
##             Arizona 15 0.004774029
##            Arkansas 75 0.023870146
##          California 58 0.018459580
##            Colorado 64 0.020369192
Oregon.SF <- Counties.SF %>% filter(state_name=="Oregon")
ggplot(Oregon.SF) + geom_sf()

Interesting that Oregon never actually looks the way it should because of projections. Mercator is more common.

library(ggthemes); library(ggrepel)
Oregon.SF <- Oregon.SF %>% mutate(County = str_remove(county_name, " County"))
ggplot(Oregon.SF, aes(geometry=geometry)) + geom_sf() + coord_sf(crs=3785, datum=NA) + geom_sf_text(aes(label = County)) + theme(text = element_text(size = 1))

ggplot(Oregon.SF, aes(geometry=geometry)) + 
  geom_sf() + 
  coord_sf(crs=3785, datum=NA) + 
#  geom_sf_text(aes(label = County)) + 
#  theme(text = element_text(size = 1))
  ggrepel::geom_text_repel(aes(label = County), stat = "sf_coordinates",
    min.segment.length = 0,
    colour = "red",
    segment.colour = "red",
    size = 3,
    box.padding = unit(0.05, "lines")) + theme_map()

To join the data together, we are going to need an appropriate merge column. The named counties in Oregon from the map are:

Oregon.SF %>% tabyl(county_name) %>% head()
##  county_namegeometry n    percent
##         Baker County 1 0.02777778
##        Benton County 1 0.02777778
##     Clackamas County 1 0.02777778
##       Clatsop County 1 0.02777778
##      Columbia County 1 0.02777778
##          Coos County 1 0.02777778

The data have named counties also, they look like this:

Oregon.COVID %>% tabyl(County) %>% head()
##     County n    percent
##      Baker 1 0.02777778
##     Benton 1 0.02777778
##  Clackamas 1 0.02777778
##    Clatsop 1 0.02777778
##   Columbia 1 0.02777778
##       Coos 1 0.02777778

To match them up, I will add to the existing names in Oregon.COVID with the missing verbiage. After reconciling the names, combine the data and the map using a left_join with the map as the base and attaching matching data so that all the counties that we wish to map are available even if some are missing data in the merge.

COVID-19 in Oregon

Oregon.COVID <- Oregon.COVID %>% mutate(county_name = paste(County,"County", sep=" "))
Map.Me <- left_join(Oregon.SF,Oregon.COVID, by="county_name")
ggplot(Map.Me, aes(geometry=geometry, fill=Number.of.cases)) + geom_sf() + coord_sf(crs=3785, datum=NA) + scale_fill_viridis_c() + theme_minimal() + labs(title="COVID-19 in Oregon")

Or even better

library(ggrepel)
ggplot(Map.Me, aes(geometry=geometry, fill=Number.of.cases, label=County.x)) + 
  geom_sf() +
  coord_sf(crs=3785, datum=NA) + 
  geom_label_repel(stat = "sf_coordinates",
    min.segment.length = 0,
    colour = "white",
    segment.colour = "white",
    size = 3,
    box.padding = unit(0.05, "lines"))  + scale_fill_continuous_tableau("Red") + theme_minimal() + labs(title="COVID-19 in Oregon", x="", y="", caption="Made with R, ggplot2, and ggrepel by @PieRatio \n data: https://govstatus.egov.com/OR-OHA-COVID-19")

A Leaflet

library(widgetframe); library(leaflet); library(here); library(htmlwidgets); library(htmltools)
m <- leaflet() %>% addProviderTiles("OpenStreetMap.Mapnik") %>% setView(lat=43.8041, lng=-120.5542, zoom=6) %>% addTiles()
frameWidget(m)

So I have a base leaflet to work with. There are issues with showing multiple framewidgets so I will skip displaying the basic map of Oregon.

Final Leaflet

Merge the relevant data together after using TIGER to grab the spatial definitions.

library(widgetframe); library(leaflet); library(here); library(htmlwidgets)
library(tigris); library(rgdal); library(htmltools); library(viridis)
counties.t <- counties(state = "41", resolution = "500k", class="sf")
OC22 <- Oregon.COVID %>% filter(date=="2020-03-22")
Map.L <- merge(counties.t, OC22, by.x="NAME", by.y= "County")

Build the final plot. The first line creates a palette. Then I build the leaflet

mypal <- colorNumeric(palette = "viridis", domain = Map.L$Number.of.cases, na.color = "grey")
m2 <- leaflet() %>% 
  addProviderTiles("OpenStreetMap.Mapnik") %>% 
  setView(lat=43.8041, lng=-120.5542, zoom=6) %>% 
  addTiles()  %>% 
  addPolygons(data=Map.L, 
              color = "white", 
              fillOpacity = 0.3, 
              fillColor = mypal(Map.L$Number.of.cases), 
              weight=0.5, 
              highlightOptions = highlightOptions(color = "white", weight = 2, bringToFront = TRUE), 
              label = lapply(Map.L$PTT, htmltools::HTML)) %>%
  addLegend("bottomleft", pal = mypal, values = Map.L$Number.of.cases, title = "Coronavirus Cases in Oregon", opacity = 0.3)
frameWidget(m2)