Overdose Deaths In The USA
Graphs of weekly overdose deaths in the USA using CDC data
Data
Drug overdoses, suicides & transportation related deaths
Prepare Data
# devtools::install_github("derekmichaelwright/agData")
library(agData)
Prepare Data
# Prep data
<- read.csv("data_usa_overdoses.csv") %>%
dd rename(Area=State, Date=Week.Ending.Date) %>%
mutate(Date = as.Date(Date, format = "%m/%d/%Y"))
# Remove states with no data
<- NULL
areas for(i in unique(dd$Area)) {
<- dd %>% filter(Area == i)
xi if(sum(!is.na(xi$Rolling.4.Week.Mean)) < 1) { areas <- c(areas, i) }
}<- dd %>% filter(!Area %in% areas)
dd <- "www.dblogr.com/ or derekmichaelwright.github.io/dblogr/ | Data: CDC\nNote: most recent years data may be incomplete" myCaption
Weekly Overdoses
# Create plotting function
<- function(area = "United States") {
overdosePlot1 # Prep data
<- as.Date(c("2016-01-01","2017-01-01","2018-01-01",
vv "2019-01-01","2020-01-01","2021-01-01"))
<- dd %>% filter(Outcome == "Drug Overdose") %>%
xx filter(Area %in% area)
# Plot
ggplot(xx, aes(x = Date, y = Rolling.4.Week.Mean)) +
geom_col(size = 1, fill = "darkred", alpha = 0.8) +
geom_vline(xintercept = vv, lty = 2, alpha = 0.5) +
facet_wrap(Area ~ ., scales = "free_y") +
scale_x_date(date_breaks = "1 year", date_labels = "%Y",
minor_breaks = "1 year") +
theme_agData(legend.position = "bottom") +
labs(y = "Weekly Deaths (Rolling 4 Week Mean)", x = NULL,
caption = myCaption)
}
United States
<- overdosePlot1(area = "United States")
mp ggsave("usa_overdoses_1_01.png", mp, width = 6, height = 4)
ggsave("featured.png", mp, width = 6, height = 4)
All States
<- overdosePlot1(area = unique(dd$Area))
mp ggsave("usa_overdoses_1_02.png", mp, width = 20, height = 10)
Arizona
<- overdosePlot1(area = "Arizona")
mp ggsave("usa_overdoses_1_03.png", mp, width = 6, height = 4)
California
<- overdosePlot1(area = "California")
mp ggsave("usa_overdoses_1_04.png", mp, width = 6, height = 4)
Colorado
<- overdosePlot1(area = "Colorado")
mp ggsave("usa_overdoses_1_05.png", mp, width = 6, height = 4)
New York
<- overdosePlot1(area = "New York")
mp ggsave("usa_overdoses_1_06.png", mp, width = 6, height = 4)
Texas
<- overdosePlot1(area = "Texas")
mp ggsave("usa_overdoses_1_07.png", mp, width = 6, height = 4)
Yearly Deaths
# Create plotting function
<- function(area = "United States") {
overdosePlot2 # Prep data
<- dd %>%
xx mutate(Year = substr(Date, 1, 4)) %>%
filter(Area %in% area, Outcome == "Drug Overdose") %>%
group_by(Area, Year) %>%
summarise(Value = sum(Rolling.4.Week.Mean, na.rm = T)) %>%
mutate(YearGroup = ifelse(Year < 2020, "Pre-Covid", "Covid"),
YearGroup = factor(YearGroup, levels = c("Pre-Covid", "Covid")))
<- c(alpha("darkred",0.3), alpha("darkred",0.6))
myCols # Plot
ggplot(xx, aes(x = Year, y = Value / 1000)) +
geom_col(aes(fill = YearGroup), color = "black") +
geom_label(aes(label = round(Value / 1000, 1)), vjust = 1) +
facet_wrap(Area ~ ., scales = "free_y") +
scale_fill_manual(name = NULL, values = myCols) +
theme_agData(legend.position = "bottom") +
labs(title = "Yearly Drug Overdoses", y = "Thousand Deaths", x = NULL,
caption = myCaption)
}
United States
<- overdosePlot2(area = "United States")
mp ggsave("usa_overdoses_2_01.png", mp, width = 6, height = 4)
All States
<- overdosePlot2(area = unique(dd$Area))
mp ggsave("usa_overdoses_2_02.png", mp, width = 20, height = 10)
Arizona
<- overdosePlot2(area = "Arizona")
mp ggsave("usa_overdoses_2_03.png", mp, width = 6, height = 4)
California
<- overdosePlot2(area = "California")
mp ggsave("usa_overdoses_2_04.png", mp, width = 6, height = 4)
Colorado
<- overdosePlot2(area = "Colorado")
mp ggsave("usa_overdoses_2_05.png", mp, width = 6, height = 4)
New York
<- overdosePlot2(area = "New York")
mp ggsave("usa_overdoses_2_06.png", mp, width = 6, height = 4)
Texas
<- overdosePlot2(area = "Texas")
mp ggsave("usa_overdoses_2_07.png", mp, width = 6, height = 4)
Weekly Deaths
# Create plotting function
<- function(area = "Alaska") {
overdosePlot2 # Prep data
<- c("darkred", "darkorange", "darkgreen")
colors <- as.Date(c("2016-01-01","2017-01-01","2018-01-01",
vv "2019-01-01","2020-01-01","2021-01-01"))
<- dd %>%
xx filter(Area %in% area, Date > "2016-02-27")
# Plot
ggplot(xx, aes(x = Date, y = Rolling.4.Week.Mean, color = Outcome)) +
geom_line(size = 1, alpha = 0.8) +
geom_vline(xintercept = vv, lty = 2, alpha = 0.5) +
facet_wrap(Area ~ ., scales = "free_y") +
scale_color_manual(name = NULL, values = colors) +
scale_x_date(date_breaks = "1 year", date_labels = "%Y",
minor_breaks = "1 year") +
theme_agData(legend.position = "bottom") +
labs(y = "Weekly Deaths (Rolling 4 Week Mean)", x = NULL,
caption = myCaption)
}
United States
<- overdosePlot2(area = "United States")
mp ggsave("usa_overdoses_3_01.png", mp, width = 6, height = 4)
All States
<- overdosePlot2(area = unique(dd$Area))
mp ggsave("usa_overdoses_3_02.png", mp, width = 20, height = 10)
Arizona
<- overdosePlot2(area = "Arizona")
mp ggsave("usa_overdoses_3_03.png", mp, width = 6, height = 4)
California
<- overdosePlot2(area = "California")
mp ggsave("usa_overdoses_3_04.png", mp, width = 6, height = 4)
Colorado
<- overdosePlot2(area = "Colorado")
mp ggsave("usa_overdoses_3_05.png", mp, width = 6, height = 4)
New York
<- overdosePlot2(area = "New York")
mp ggsave("usa_overdoses_3_06.png", mp, width = 6, height = 4)
Texas
<- overdosePlot2(area = "Texas")
mp ggsave("usa_overdoses_3_07.png", mp, width = 6, height = 4)