Tracking COVID-19 in Ohio’s Counties

The New York Times is releasing a series of data files with cumulative counts of coronavirus cases in the United States, at the state and county level, over time. They are compiling this time series data from state and local governments and health departments in an attempt to provide a complete record of the ongoing outbreak. This is a map built with their data and updated (almost) daily to track progress in Ohio’s counties. The values displayed in the first heatmap are the weekly cumulative number of cases per 10,000 persons (the population estimates are from the 2015-2019 American Community Survey). Preview image is Brian McGowan’s, courtesy of Unsplash.

This post was originally written on 2020-04-13

The New York Times is releasing a series of data files with cumulative counts of coronavirus cases in the United States, at the state and county level, over time. They are compiling this time series data from state and local governments and health departments in an attempt to provide a complete record of the ongoing outbreak. This is a map built with their data and updated (almost) daily to track progress in Ohio’s counties. The values displayed in the first heatmap are the weekly cumulative number of cases per 10,000 persons (the population estimates are from the 2015-2019 American Community Survey).

The second heatmap reflects the cumulative weekly total number of cases per se.

Here is the code, but note that you will need to tweak the height and width in the frameWidget() to fit your needs:

library(tidyverse)

readr::read_csv("https://raw.githubusercontent.com/nytimes/covid-19-data/master/us-counties.csv") -> ohc

ohc %>%
  filter(state == "Ohio") %>%
  rename(Date = date, County = county) %>%
  mutate(day = lubridate::day(Date)) -> ohc

ohc %>%
  mutate(
    weeknum = lubridate::week(Date),
    year = lubridate::year(Date),
    Week = as.Date(paste(year, weeknum, 2, sep = "-"), "%Y-%U-%u")
    ) -> ohc

library(tidycensus)
get_acs(geography = "county", state = "39", year = 2018, variables = "B00001_001") -> popn

ohc %>%
    left_join(popn[, c(1, 4)], by = c("fips" = "GEOID")) %>%
    mutate(Rate = (cases / estimate) * 10000) %>%
    filter(!is.na(Rate)) -> ohc7

library(viridis)
library(highcharter)
library(htmltools)
library(widgetframe)

fntltp <- JS("function(){
  return this.series.xAxis.categories[this.point.x] + ', ' +  this.series.yAxis.categories[this.point.y] + ': ' +Highcharts.numberFormat(this.point.value, 0) + '';}")

hchart(ohc7, "heatmap",
       hcaes(x = Week, y = County, value = Rate)) %>%
  hc_colorAxis(stops = color_stops(10, rev(magma(10))),
               type = "logarithmic") %>%
  hc_yAxis(reversed = TRUE, offset = 0, tickLength = 1,
           gridLineWidth = 0, minorGridLineWidth = 0,
           labels = list(style = list(fontSize = "8px"))) %>%
  hc_xAxis(offset = 10, angle = 0, gridLineWidth = 0,
           tickInterval = 28,
           labels = list(style = list(fontSize = "10px"))) %>%
  hc_tooltip(formatter = fntltp) %>%
  hc_title(text = "COVID-19 Confirmed Case Rate in Ohio's Counties (per 10,000 persons)") %>%
  hc_legend(layout = "vertical", verticalAlign = "top",
            align = "right", valueDecimals = 0) %>%
  frameWidget(height = 1200)

fntltp <- JS("function(){
  return this.series.xAxis.categories[this.point.x] + ', ' +  this.series.yAxis.categories[this.point.y] + ': ' +Highcharts.numberFormat(this.point.value, 0) + '';}")

hchart(ohc7, "heatmap",
       hcaes(x = Week, y = County, value = cases)) %>%
  hc_colorAxis(stops = color_stops(10, rev(magma(10))),
               type = "logarithmic") %>%
  hc_yAxis(reversed = TRUE, offset = 0, tickLength = 1,
           gridLineWidth = 0, minorGridLineWidth = 0,
           labels = list(style = list(fontSize = "8px"))) %>%
  hc_xAxis(offset = 10, angle = 0, gridLineWidth = 0,
           tickInterval = 28,
           labels = list(style = list(fontSize = "10px"))) %>%
  hc_tooltip(formatter = fntltp) %>%
  hc_title(text = "Total Number of COVID-19 Confirmed Cases in Ohio's Counties") %>%
  hc_legend(layout = "vertical", verticalAlign = "top",
            align = "right", valueDecimals = 0) %>%
  frameWidget(height = 1200)