Texas Covid-19 Interactive Map

Using LEAFLET and WIDGET to map Covid-19 cases in Texas counties. Map clickable popups. The mapped data represents total cumulative cases as of the date in the code below, as recorded by the New York Times and reported in its github repository of data on the coronavirus.

For an example of this in action, see this website.




Libraries needed:

library(sf);library(raster);library(dplyr);library(spData);
library(tmap);library(leaflet); library(mapview); library(ggplot2); library(shiny);  
library(rgdal);library(broom);library(tidyverse);library(tigris); library(rgdal);
library(htmltools);library(viridis); library(raster);library(sp);library(RCurl);
library(tidycensus);library(tidyverse);library(tmaptools);library(manipulateWidget);
library(leaflet.minicharts)

(well, OK, I don’t need all those libraries for this function, but I just keep that chuck for all my mapping needs.)

Get the data

For this, we need geometry data, which we can get from the tigris library (which is great for scraping the Census Tiger shapefiles) and in the ACS files if we use the tidycensus library. The ACS file is great because it has the geometry AND the population data, but you have to know which Census table to pull (identified by the “variables” option in the code. See the tidycensus descriptions for more details on this cool library.

I overdo it here by pulling the ACS data (get_acs) AND the Tiger files (texas <- counties). But it works. I should go back and clean up this code and make it shorter.

tigris_year = 2019
#key="get-yours-from-Census" #<----type your apicode here
#readRenviron("~/.Renviron")
#Sys.setenv(CENSUS_KEY='get-yours-from-Census')#<----type your apicode here again
options(tigris_use_cache = TRUE)

pop <- get_acs(geography = "county", variables = 'B01003_001', 
            state = "TX", survey='acs5',geometry = TRUE,year=2018) 

covt <- read.csv(text=getURL(
  "https://raw.githubusercontent.com/nytimes/covid-19-data/master/us-counties.csv"))

covt=filter(covt,state == 'Texas',date=='2020-04-24') # DATE FILTER HERE

texas <- counties(state = 'TX', cb = TRUE, resolution = '20m')

txcov <- geo_join(texas,covt, "NAME","county")
txcov$cases[is.na(txcov$cases)] <- 0
txcov$deaths[is.na(txcov$deaths)] <- 0
tx2 <- geo_join(txcov,pop,'GEOID','GEOID')
rm(covt,texas,txcov,pop)

Set up the map

I am interested in the cases, the cases per 100,000 population, the number of deaths, and the number of deaths per 100,000. The per 100,000 measures need to be calculated from the population data pulled from the ACS.

I create specialized bins for the color coding because of the weird distribution of the data.

tx2$casepop=(tx2$cases/tx2$estimate*100000)
tx2$casepop=round(tx2$casepop, digits = 1)
tx2$deathpop=(tx2$deaths/tx2$estimate*100000)
tx2$deathpop=round(tx2$deathpop, digits = 1)


mybins <- c(0,1,10,50,100,500,Inf)
binpalet <- colorBin('viridis',tx2$cases,mybins)
pops <- paste("<strong>County: </strong>",tx2$NAME,
              "<br><strong>Cases:  </strong>", tx2$cases)

mybins2 <- c(0,1,5,10,20,40,60,Inf)
binpalet2 <- colorBin('viridis',tx2$casepop,mybins2)
pops2 <- paste("<strong>County: </strong>",tx2$NAME,
              "<br><strong>Cases Per 100,000:  </strong>", tx2$casepop,
              "<br><strong>Total Cases:  </strong>", tx2$cases)

mybins3 <- c(0,1,2,4,6,8,10,12,Inf)
binpalet3 <- colorBin('viridis',tx2$deaths,mybins3)
pops3 <- paste("<strong>County: </strong>",tx2$NAME,
               "<br><strong>Deaths:  </strong>", tx2$deaths)

mybins4 <- c(0,1,2,3,4,5,10,Inf)
binpalet4 <- colorBin('viridis',tx2$deathpop,mybins4)
pops4 <- paste("<strong>County: </strong>",tx2$NAME,
               "<br><strong>Deaths Per 100,000:  </strong>", tx2$deathpop,
               "<br><strong>Total Deaths:  </strong>", tx2$deaths)

Make the leaflets

I wouldn’t need a widget if I only wanted to build one leaflet map. The leaflet map is nice compared to other formats because of the interactivity. I could have done this in other ways, but I was interested in the leaflet version for this.

The WIDGET function allows me to create four different leaflets and put them all on one page, which is pretty nice.

myWidget <- combineWidgets(ncol=2,title='Covid-19 Cases in Texas',
# 1
 leaflet(data=tx2) %>%
    addTiles() %>%
    addPolygons(smoothFactor = 0.2,
              weight=.6,color = ~binpalet(cases), fillOpacity = .8,
              popup = pops)%>%
    addLegend("bottomright", pal = binpalet, values = ~cases,
            title = "Cases",opacity = .5),
 # 2
  leaflet(data=tx2) %>%
    addTiles() %>%
    addPolygons(smoothFactor = 0.2,
                weight=.6,color = ~binpalet2(casepop), fillOpacity = .8,
                popup = pops2)%>%
    addLegend("bottomright", pal = binpalet2, values = ~casepop,
              title = "Cases per 100,000",opacity = .5),
# 3
leaflet(data=tx2) %>%
  addTiles() %>%
  addPolygons(smoothFactor = 0.2,
              weight=.6,color = ~binpalet3(deaths), fillOpacity = .8,
              popup = pops3)%>%
  addLegend("bottomright", pal = binpalet3, values = ~deaths,
            title = "Deaths",opacity = .5),
# 4
leaflet(data=tx2) %>%
  addTiles() %>%
  addPolygons(smoothFactor = 0.2,
              weight=.6,color = ~binpalet4(deathpop), fillOpacity = .8,
              popup = pops4)%>%
  addLegend("bottomright", pal = binpalet4, values = ~deathpop,
            title = "Deaths per 100,000",opacity = .5))
myWidget