Plot US COVID Cases and Deaths in the "SLOWDOWN" (or phase-plane) style

dorling_style_covid_cases_and_deaths.R

library(tidyverse)
library(magrittr)
library(geomtextpath)

df_usa <- readr::read_csv("https://raw.githubusercontent.com/nytimes/covid-19-data/master/rolling-averages/us.csv")

ma <- function(x, n = 31){stats::filter(x, rep(1 / n, n), sides = 2)}

df_usa %<>% mutate(
  deaths_avg = as.numeric(ma(deaths_avg)),
  daily_change = deaths_avg - lag(deaths_avg)) 

df_usa %<>% mutate(
  cases_avg = as.numeric(ma(cases_avg)),
  daily_change_cases = cases_avg - lag(cases_avg)) 

df_usa %<>% mutate(
  period_indicator = case_when(
    date <= lubridate::ymd("2020-3-31") ~ "Spring 2020",
    date <= lubridate::ymd("2020-12-31") ~ "Fall 2020",
    date <= lubridate::ymd("2021-6-15") ~ "Spring 2021",
    date <= lubridate::ymd("2021-12-31") ~ "Fall 2021",
    date <= lubridate::ymd("2022-6-15") ~ "2022"
    )
  )

ggplot(df_usa, 
  aes(x = daily_change, 
    y = deaths_avg, 
    color = date, 
    label = period_indicator)) + 
  geom_textpath(
    alpha = 0.5, 
    lineend='butt', 
    linejoin = 'bevel', 
    linewidth = 1, 
    size = 2.5, 
    lineheight = 2, 
    fontface = 'bold', 
    spacing = 60, 
    text_smoothing = 52) + 
  scale_color_viridis_c(end = .8) + 
  ylab("31-Day Moving Average of Daily Deaths") + 
  xlab("Increase or Decrease in 31-Day Moving Average of Daily Deaths") + 
  theme_bw() + 
  ggtitle("31-day Moving Average of Daily COVID-19 Deaths in the United States") + 
  labs(caption = "Data from https://github.com/nytimes/covid-19-data/blob/master/rolling-averages/us.csv") + 
  expand_limits(x = c(-max(df_usa$daily_change, na.rm=T), max(df_usa$daily_change, na.rm=T))) + 
  theme(legend.position = 'none') 

ggsave("31_day_moving_avg_deaths.png", height = 7, width = 7)

ggplot(df_usa, 
  aes(x = daily_change_cases, 
    y = cases_avg, 
    color = date, 
    label = period_indicator)) + 
  geom_textpath(
    alpha = 0.5, 
    lineend='butt', 
    linejoin = 'bevel', 
    linewidth = 1, 
    size = 2.5, 
    lineheight = 2, 
    fontface = 'bold', 
    spacing = 60, 
    text_smoothing = 52) + 
  scale_color_viridis_c(end = .8) + 
  ylab("31-Day Moving Average of Daily Cases") + 
  xlab("Increase or Decrease in 31-Day Moving Average of Daily Cases") + 
  scale_y_continuous(labels = scales::comma_format()) + 
  theme_bw() + 
  ggtitle("31-day Moving Average of Daily COVID-19 Cases in the United States") + 
  labs(caption = "Data from https://github.com/nytimes/covid-19-data/blob/master/rolling-averages/us.csv") + 
  expand_limits(x = c(-max(df_usa$daily_change, na.rm=T), max(df_usa$daily_change, na.rm=T))) + 
  theme(legend.position = 'none') 

ggsave("31_day_moving_avg_cases.png", width = 7, height = 7)

This work was inspired by Danny Dorling's page on "SLOWDOWN" style figures.

https://www.dannydorling.org/books/SLOWDOWN/Illustrations.html

Andrew Gelman et al have some discussions about the figures on Dorling's website here:

https://statmodeling.stat.columbia.edu/2022/01/12/this-is-a-great-graph-plotting-yt-vs-yt-tracing-over-time-with-a-dot-for-each-year/

https://statmodeling.stat.columbia.edu/2022/01/16/what-went-wrong-in-the-labeling-of-those-cool-graphs-of-yt-vs-yt/