When did we pass 100k excess deaths?

nat100k <- nat %>% 
  filter(year==2020) %>% 
  filter(week>=10)

x <- 1
deaths <- 0

while (deaths <100000) {
  deaths <- deaths + nat100k$excess_all_cause_deaths[x]
  x <- x+1
}
x <- x-1

month_of <- month(nat100k$week_end_date[x], label=T)
day_of <- day(nat100k$week_end_date[x])

print(paste0("We passed 100,000 excess deaths by ", month_of, " ", day_of, ", 2020"))
## [1] "We passed 100,000 excess deaths by May 9, 2020"

Percent over time

nat_latest <- nat %>% 
  filter(year==2020) %>% 
  filter(week>=10) %>% 
  mutate(percent=round(covid19.nchs/excess_all_cause_deaths*100))

nat_latest$percent <- ifelse(nat_latest$percent >100 | nat_latest$percent <0, NA, nat_latest$percent)

nat_table_percent <- nat_latest %>% 
  select(week_end_date, excess_all_cause_deaths, covid19.nchs, percent)

kable(nat_table_percent, format.args = list(big.mark = ","))
week_end_date excess_all_cause_deaths covid19.nchs percent
2020-03-07 -109 144
2020-03-14 -537 266
2020-03-21 773 626 81
2020-03-28 5,537 2,852 52
2020-04-04 14,843 8,997 61
2020-04-11 21,951 14,906 68
2020-04-18 19,787 15,220 77
2020-04-25 16,597 13,038 79
2020-05-02 12,705 10,659 84
2020-05-09 11,686 9,864 84
2020-05-16 9,769 8,016 82
2020-05-23 7,253 6,132 85
2020-05-30 5,772 5,007 87
2020-06-06 5,373 3,714 69
2020-06-13 4,064 2,002 49
2020-06-20 -27,719 458 
ggplot(nat_table_percent, aes(x=week_end_date, y=percent)) +
  geom_col() +
  theme_minimal() +
  labs(title="Covid-19 deaths as % of excess deaths")

mar28 <- nat_table_percent %>% 
  filter(week_end_date==ymd("2020-03-28")) %>% 
  pull(percent)

apr18 <- nat_table_percent %>% 
    filter(week_end_date==ymd("2020-04-18")) %>% 
  pull(percent)

may2 <- nat_table_percent %>% 
  filter(week_end_date==ymd("2020-05-02")) %>% 
  pull(percent)

may9 <- nat_table_percent %>% 
  filter(week_end_date==ymd("2020-05-09")) %>% 
  pull(percent)

As of May 2 it was 84 percent, compared to 52 percent as of March 28 and 77 percent as of April 18.

At the beginning of the pandemic, only about half of the excess deaths were attributed to covid-19. Since then, that ratio has improved to 4 out of 5.

States

New York, Massachusetts, New Jersey, DC, Maryland, and Colorado have been better at closing the gap.

states <- read_csv("data/outputs/national_and_state_summary.csv") %>% 
  filter(state!="US.agg") %>% 
  rename(covid19.nchs=covid.death.hybrid) %>% 
  filter(!is.na(week_start_date))

dates <- MMWRweek(states$week_start_date)

states$year <- dates$MMWRyear
states$day <- dates$MMWRday
states$week <- dates$MMWRweek

state_table <- states %>% 
  filter(year==2020) %>% 
  filter(week>=10) %>% 
  mutate(percent=round(covid19.nchs/excess_all_cause_deaths*100))

state_table$percent <- ifelse(state_table$percent > 100 | state_table$percent < 0, NA, state_table$percent)
ggplot(state_table, aes(week_end_date, percent)) +
  geom_line() +
  facet_geo(~ state, grid = "us_state_grid2") +
  ylab("Covid-19 deaths as % of excess deaths") +
  labs(title="Covid-19 deaths as % of excess deaths")

South Carolina 30 percent (1087 excess deaths, 326 covid-19) Started out at 11 percent and then reached a high of 63 percent at the end of April but has since declined.

Arizona 40 percent (1424 excess deaths, 565 covid-19) Peaked in mid April but declined since then.

Alabama 63 percent (738 excess, 462 covid) They did better in the second half of April and have been declining since.

Missouri 68 percent (775 excess, 526 covid) Seems like they’re struggling.

Florida 67 percent (2750 deaths, 1838 covid) Same as Arizona. Closed the gap in mid April and have since been declining.

Georgia 64 percent (2006 deaths, 1282 covid) Getting better over time. Last week of data being the exception.

Wisconsin 78 percent (552 deaths, 430 covid) Same as Arizona and Florida. Slightly improved in mid April but have been declining since.

Covid-19 deaths as % of excess deaths

state_percent <- state_table %>% 
    mutate(date=paste0(month(week_end_date, label=T), " ", day(week_end_date))) %>% 
  select(state, date, percent) %>% 
  pivot_wider(names_from="date",
              values_from="percent")

datatable(state_percent)

Deaths

state_totals <- state_table %>% 
    mutate(date=paste0(month(week_end_date, label=T), " ", day(week_end_date))) %>% 
  select(state, week, date=week_end_date, excess=excess_all_cause_deaths, covid19=covid19.nchs, percent) 

datatable(state_totals, filter="top")