Animated GIF

I was so struck by the clear inverse correlation between masks and cases that I made an animated GIF with the contrasting charts cycling back and forth.

Exceptions Worth Noting

It should be noted that the NYT found there to be some marginal variance in the actual level of mask wearers and the reported answers from the survey.

Researchers who hand-counted Wisconsin grocery shoppers in May and June found about 40 percent of shoppers wore masks, a level that is lower than the 45 percent who said they always wore masks in the recent Dynata sample (another 24 percent said they frequently wore masks).

They noted that it didn’t affect the result in aggregate. But it bears further scrutiny as more emphasis on masks is placed by public officials and the “virtue signal” of answering the questionnaires/surveys widen the gap with actual use.

The code behind the reports

# begin setup code chunk
library(tidyverse)
library(highcharter)
library(widgetframe)
library(lubridate)

counties <- read.csv("../../data/us_county.csv", header = TRUE)

counties <-
  counties %>%
  mutate(fips = str_pad(fips, 5, side = 'left', pad = '0'))

county_pop <- select(counties, fips, state, population)

mask_URL <- 
  "https://raw.githubusercontent.com/nytimes/covid-19-data/master/mask-use/mask-use-by-county.csv"

mask_data <- read.csv(mask_URL)

mask_data <- 
  mask_data %>%
  mutate(COUNTYFP = str_pad(COUNTYFP, 5, side = 'left', pad = '0'))  %>%
  select(COUNTYFP, NEVER, RARELY, SOMETIMES, FREQUENTLY, ALWAYS) %>%
  mutate(always_pct = (ALWAYS * 100)) %>%
  rename(fips = COUNTYFP) %>%
  left_join(county_pop, fips = fips) %>%
  rename(location = state)

last_updated <- paste("Source: New York Times  -  Report Last Updated:"
                        ,  format(Sys.time(), "%a %b %d %Y %X"))

# end setup code chunk

widget <- hcmap("countries/us/us-all-all",
      data = mask_data,
      value = "always_pct",
      name = "Percentage that always wears masks in public",
      join = "fips") %>%
  hc_colorAxis(minColor = "white", maxColor = "#32644F") %>% 
  hc_title(text = "Percentage of US Respondants Claiming to Always Wear Masks in Public"
            , align = "center") %>%
    hc_chart(
      borderColor = 'rgba(160, 160, 160, 0.3)',
      borderRadius = 8,
      borderWidth = 2) %>%
  hc_tooltip(pointFormat = "State: {point.location}
 {point.name} County: {point.value}%")%>%
  hc_legend(layout = "vertical", verticalAlign = "top",
            align = "right", valueDecimals = 0) %>%
  hc_credits(enabled = TRUE,
             text = last_updated,
             position = list(align = "left", x = 10, y = -5))

frameWidget(widget, height="100%", width="40rem")

# begin setup code chunk
library(tidyverse)
library(highcharter)
library(widgetframe)
library(lubridate)

counties <- read.csv("../../data/us_county.csv", header = TRUE)

counties <-
  counties %>%
  mutate(fips = str_pad(fips, 5, side = 'left', pad = '0'))

county_pop <- select(counties, fips, state, population)

US_COVID_data <- 
  "https://raw.githubusercontent.com/nytimes/covid-19-data/master/live/us-counties.csv"

us_data <- read.csv(US_COVID_data)

us_data_map <- 
  us_data %>%
  filter(fips != "") %>%
  mutate(date = ymd(date)) %>%
  mutate(fips = str_pad(fips, 5, side = 'left', pad = '0')) %>%
  select(date, fips, state, county, cases, deaths)  %>%
  left_join(county_pop, fips = fips) %>%
  arrange(fips, date) %>%
  mutate(ncpht = ((cases / population) * 100000)) %>%
  mutate(ndpht = ((deaths / population) * 100000)) %>%
  ungroup() %>%
  rename(location = state)

last_updated <- paste("Source: New York Times  -  Report Last Updated:"
                        ,  format(Sys.time(), "%a %b %d %Y %X"))

# end setup code chunk

widget <- hcmap("countries/us/us-all-all",
      data = mask_data,
      value = "always_pct",
      name = "Percentage that always wears masks in public",
      join = "fips") %>%
  hc_colorAxis(minColor = "white", maxColor = "#32644F") %>% 
  hc_title(text = "Percentage of US Respondants Claiming to Always Wear Masks in Public"
            , align = "center") %>%
    hc_chart(
      borderColor = 'rgba(160, 160, 160, 0.3)',
      borderRadius = 8,
      borderWidth = 2) %>%
  hc_tooltip(pointFormat = "State: {point.location}
 {point.name} County: {point.value}%")%>%
  hc_legend(layout = "vertical", verticalAlign = "top",
            align = "right", valueDecimals = 0) %>%
  hc_credits(enabled = TRUE,
             text = last_updated,
             position = list(align = "left", x = 10, y = -5))

frameWidget(widget, height="100%", width="40rem")