Between March 1 and August 16

Caveats: Selected causes of death are shown, based on analyses of the most prevalent comorbid conditions reported on death certificates where COVID-19 was listed as a cause of death (see https://www.cdc.gov/nchs/nvss/vsrr/covid_weekly/index.htm#Comorbidities). Cause of death counts are based on the underlying cause of death, and presented for Respiratory diseases, Circulatory diseases, Malignant neoplasms, and Alzheimer disease and dementia. Estimated numbers of deaths due to these other causes of death could represent misclassified COVID-19 deaths, or potentially could be indirectly related to COVID-19 (e.g., deaths from other causes occurring in the context of health care shortages or overburdened health care systems). Deaths with an underlying cause of death of COVID-19 are not included in these estimates of deaths due to other causes. Deaths due to external causes (i.e. injuries) or unknown causes are excluded.

Data from the CDC:

library(tidyverse)
library(knitr)
library(janitor)
library(lubridate)

# run 01_all_causes.R and 02_causes_modeling.R to generate the spreadsheet below

todays_date <- as.character(Sys.Date())
file_path <-  paste0("cause.summary.state.df_", todays_date, ".csv")
causes <- read_csv(file_path)


type_list <- unique(causes$type)

states_list <- c("GA", "NYC", "FL", "NJ", "MI", "US")

weeks_in <- 1:33
weeks_march <- 10:33

causes %>% 
  group_by(state, type) %>% 
  filter(mmwr_year==2020) %>% 
  filter(state=="US") %>% 
  filter(mmwr_week %in% weeks_march) %>% 
   rename(deaths=obs,
         `excess deaths`=unexplained.cases,
         expected=pred,
         `expected upper range`=upi,
         `expected lower range`=lpi
  )   %>% 
  summarize(
          `expected deaths`=sum(expected),
          `actual deaths`=sum(deaths),
          `excess deaths`=sum(`excess deaths`)) %>% 
  mutate(`percent diff`=round((`actual deaths`-`expected deaths`)/`expected deaths`*100,2)) %>% 
  kable(format.args = list(big.mark = ","))
state type expected deaths actual deaths excess deaths percent diff
US Alzheimer disease and dementia 120,996.0 134,192 13,196.0 10.91
US Circulatory diseases 394,413.5 403,952 9,538.5 2.42
US Malignant neoplasms 273,070.5 267,065 -6,005.5 -2.20
US Other select causes 78,969.5 84,386 5,416.5 6.86
US Residual (all other natural causes) 161,355.0 140,771 -20,584.0 -12.76
US Respiratory diseases 122,979.5 121,223 -1,756.5 -1.43

Circulatory diseases

df <- causes %>%
    filter(type=="Circulatory diseases")

mar <- df %>% 
  filter(mmwr_year==2020) %>% 
  filter(mmwr_week %in% weeks_march) %>% 
  mutate(excess_is=case_when(
    obs < lpi ~ "Lower than range",
    obs > upi ~ "Higher than range",
    TRUE ~ "Within the range"
  )) %>%
  arrange(desc(unexplained.cases)) %>% 
  rename(deaths=obs,
         `excess deaths`=unexplained.cases,
         expected=pred,
         `expected upper range`=upi,
         `expected lower range`=lpi
  ) 

mar_summary <- mar %>% 
  filter(state %in% states_list) %>% 
  group_by(state) %>% 
  summarize(deaths=sum(deaths),
          `excess deaths`=sum(`excess deaths`))

## now for charting
df_chart <-  df %>% 
  filter(mmwr_year==2020) #%>% 
 # filter(state!="US")

df_chart %>% 
  #filter(state %in% mar_counties) %>% 
  filter(mmwr_week %in% weeks_in) %>% 
  filter(state %in% states_list) %>% 
  ggplot(aes(week_end, obs)) +
  geom_ribbon(aes(ymin=lpi, ymax=upi), fill="gray70", alpha=.8) +
  geom_line(color="firebrick", size=.5) +
  facet_wrap(~state, ncol=5, scales="free_y") +
  labs(title="State excess Circulatory diseases") +
  theme_minimal()

kable(mar_summary, format.args = list(big.mark = ","))
state deaths excess deaths
FL 31,856 809.0
GA 11,897 242.0
MI 15,578 655.5
NJ 11,822 1,130.5
US 403,952 9,538.5 
mar_summary$type <- "Circulatory diseases"
write_csv(mar_summary, "circ_disease.csv")

Alzheimer disease and dementia

df <- causes %>%
    filter(type=="Alzheimer disease and dementia")

mar <- df %>% 
  filter(mmwr_year==2020) %>% 
  filter(mmwr_week %in% weeks_march) %>% 
  mutate(excess_is=case_when(
    obs < lpi ~ "Lower than range",
    obs > upi ~ "Higher than range",
    TRUE ~ "Within the range"
  )) %>%
  arrange(desc(unexplained.cases)) %>% 
  rename(deaths=obs,
         `excess deaths`=unexplained.cases,
         expected=pred,
         `expected upper range`=upi,
         `expected lower range`=lpi
  ) 

mar_summary <- mar %>% 
  filter(state %in% states_list) %>% 
  group_by(state) %>% 
  summarize(deaths=sum(deaths),
          `excess deaths`=sum(`excess deaths`))

#mar_states <- mar %>% 
 # filter(excess_is=="Higher than range") %>% 
#  pull(state)

## now for charting
df_chart <-  df %>% 
  filter(mmwr_year==2020) #%>% 
  #filter(state!="US")

df_chart %>% 
  #filter(state %in% mar_counties) %>% 
  filter(mmwr_week %in% weeks_in) %>% 
  filter(state %in% states_list) %>% 
  ggplot(aes(week_end, obs)) +
  geom_ribbon(aes(ymin=lpi, ymax=upi), fill="gray70", alpha=.8) +
  geom_line(color="firebrick", size=.5) +
  facet_wrap(~state, ncol=5, scales="free_y") +
  labs(title="State excess Alzheimer disease and dementia") +
  theme_minimal()

kable(mar_summary, format.args = list(big.mark = ","))
state deaths excess deaths
FL 9,217 1,358.0
GA 4,272 762.0
MI 4,318 402.5
NJ 3,773 739.0
US 134,192 13,196.0 
mar_summary$type <- "alzheimer disease"
write_csv(mar_summary, "alzheimer_disease.csv")

Malignant neoplasms

df <- causes %>%
    filter(type=="Malignant neoplasms")

mar <- df %>% 
  filter(mmwr_year==2020) %>% 
  filter(mmwr_week %in% weeks_march) %>% 
  mutate(excess_is=case_when(
    obs < lpi ~ "Lower than range",
    obs > upi ~ "Higher than range",
    TRUE ~ "Within the range"
  )) %>%
  arrange(desc(unexplained.cases)) %>% 
  rename(deaths=obs,
         `excess deaths`=unexplained.cases,
         expected=pred,
         `expected upper range`=upi,
         `expected lower range`=lpi
  ) 

mar_summary <- mar %>% 
  filter(state %in% states_list) %>% 
  group_by(state) %>% 
  summarize(deaths=sum(deaths),
          `excess deaths`=sum(`excess deaths`))

#mar_states <- mar %>% 
 # filter(excess_is=="Higher than range") %>% 
#  pull(state)

## now for charting
df_chart <-  df %>% 
  filter(mmwr_year==2020) #%>% 
  #filter(state!="US")

df_chart %>% 
  #filter(state %in% mar_counties) %>% 
  filter(mmwr_week %in% weeks_in) %>% 
  filter(state %in% states_list) %>% 
  ggplot(aes(week_end, obs)) +
  geom_ribbon(aes(ymin=lpi, ymax=upi), fill="gray70", alpha=.8) +
  geom_line(color="firebrick", size=.5) +
  facet_wrap(~state, ncol=6, scales="free_y") +
  labs(title="State excess malignant neoplasms") +
  theme_minimal()

kable(mar_summary, format.args = list(big.mark = ","))
state deaths excess deaths
FL 20,874 -119.0
GA 7,887 -290.0
MI 9,277 -278.5
NJ 6,920 -43.0
US 267,065 -6,005.5

Respiratory diseases

df <- causes %>%
    filter(type=="Respiratory diseases")

mar <- df %>% 
  filter(mmwr_year==2020) %>% 
  filter(mmwr_week %in% weeks_march) %>% 
  mutate(excess_is=case_when(
    obs < lpi ~ "Lower than range",
    obs > upi ~ "Higher than range",
    TRUE ~ "Within the range"
  )) %>%
  arrange(desc(unexplained.cases)) %>% 
  rename(deaths=obs,
         `excess deaths`=unexplained.cases,
         expected=pred,
         `expected upper range`=upi,
         `expected lower range`=lpi
  ) 

mar_summary <- mar %>% 
  filter(state %in% states_list) %>% 
  group_by(state) %>% 
  summarize(deaths=sum(deaths),
          `excess deaths`=sum(`excess deaths`))

#mar_states <- mar %>% 
 # filter(excess_is=="Higher than range") %>% 
#  pull(state)

## now for charting
df_chart <-  df %>% 
  filter(mmwr_year==2020) #%>% 
  #filter(state!="US")

df_chart %>% 
  #filter(state %in% mar_counties) %>% 
  filter(mmwr_week %in% weeks_in) %>% 
  filter(state %in% states_list) %>% 
  ggplot(aes(week_end, obs)) +
  geom_ribbon(aes(ymin=lpi, ymax=upi), fill="gray70", alpha=.8) +
  geom_line(color="firebrick", size=.5) +
  facet_wrap(~state, ncol=6, scales="free_y") +
  labs(title="State excess Respiratory diseases") +
  theme_minimal()

kable(mar_summary, format.args = list(big.mark = ","))
state deaths excess deaths
FL 8,611 -406.0
GA 4,075 203.0
MI 4,187 -190.0
NJ 3,857 857.0
US 121,223 -1,756.5

Residual (all other natural causes)

df <- causes %>%
    filter(type=="Residual (all other natural causes)")

mar <- df %>% 
  filter(mmwr_year==2020) %>% 
  filter(mmwr_week %in% weeks_march) %>% 
  mutate(excess_is=case_when(
    obs < lpi ~ "Lower than range",
    obs > upi ~ "Higher than range",
    TRUE ~ "Within the range"
  )) %>%
  arrange(desc(unexplained.cases)) %>% 
  rename(deaths=obs,
         `excess deaths`=unexplained.cases,
         expected=pred,
         `expected upper range`=upi,
         `expected lower range`=lpi
  ) 

mar_summary <- mar %>% 
  filter(state %in% states_list) %>% 
  group_by(state) %>% 
  summarize(deaths=sum(deaths),
          `excess deaths`=sum(`excess deaths`))

#mar_states <- mar %>% 
 # filter(excess_is=="Higher than range") %>% 
#  pull(state)

## now for charting
df_chart <-  df %>% 
  filter(mmwr_year==2020) #%>% 
  #filter(state!="US")

df_chart %>% 
  #filter(state %in% mar_counties) %>% 
  filter(mmwr_week %in% weeks_in) %>% 
  filter(state %in% states_list) %>% 
  ggplot(aes(week_end, obs)) +
  geom_ribbon(aes(ymin=lpi, ymax=upi), fill="gray70", alpha=.8) +
  geom_line(color="firebrick", size=.5) +
  facet_wrap(~state, ncol=6, scales="free_y") +
  labs(title="State excess Residual (all other natural causes)") +
  theme_minimal()

kable(mar_summary, format.args = list(big.mark = ","))
state deaths excess deaths
FL 8,935 -3,863
GA 4,542 -260
MI 4,978 -1,281
NJ 3,605 -1,008
US 140,771 -20,584

Other select causes

df <- causes %>%
    filter(type=="Other select causes")

mar <- df %>% 
  filter(mmwr_year==2020) %>% 
  filter(mmwr_week %in% weeks_march) %>% 
  mutate(excess_is=case_when(
    obs < lpi ~ "Lower than range",
    obs > upi ~ "Higher than range",
    TRUE ~ "Within the range"
  )) %>%
  arrange(desc(unexplained.cases)) %>% 
  rename(deaths=obs,
         `excess deaths`=unexplained.cases,
         expected=pred,
         `expected upper range`=upi,
         `expected lower range`=lpi
  ) 

mar_summary <- mar %>% 
  filter(state %in% states_list) %>% 
  group_by(state) %>% 
  summarize(deaths=sum(deaths),
          `excess deaths`=sum(`excess deaths`))

#mar_states <- mar %>% 
 # filter(excess_is=="Higher than range") %>% 
#  pull(state)

## now for charting
df_chart <-  df %>% 
  filter(mmwr_year==2020) #%>% 
  #filter(state!="US")

df_chart %>% 
  #filter(state %in% mar_counties) %>% 
  filter(mmwr_week %in% weeks_in) %>% 
  filter(state %in% states_list) %>% 
  ggplot(aes(week_end, obs)) +
  geom_ribbon(aes(ymin=lpi, ymax=upi), fill="gray70", alpha=.8) +
  geom_line(color="firebrick", size=.5) +
  facet_wrap(~state, ncol=6, scales="free_y") +
  labs(title="State excess Other select causes") +
  theme_minimal()

kable(mar_summary, format.args = list(big.mark = ","))
state deaths excess deaths
FL 6,057 575.0
GA 2,883 117.0
MI 2,984 428.0
NJ 2,916 489.0
US 84,386 5,416.5