Overdose Deaths In The USA
Graphs of weekly overdose deaths in the USA using CDC data
Data
Drug overdoses, suicides & transportation related deaths
Extra
Prepare Data
# Prep data
dd <- read.csv("data_usa_overdoses.csv") %>%
rename(Area=State, Date=Week.Ending.Date) %>%
mutate(Date = as.Date(Date, format = "%m/%d/%Y"))
# Remove states with no data
areas <- NULL
for(i in unique(dd$Area)) {
xi <- dd %>% filter(Area == i)
if(sum(!is.na(xi$Rolling.4.Week.Mean)) < 1) { areas <- c(areas, i) }
}
dd <- dd %>% filter(!Area %in% areas)
myCaption <- "www.dblogr.com/ or derekmichaelwright.github.io/dblogr/ | Data: CDC\nNote: most recent years data may be incomplete"Weekly Overdoses
Plotting Function
# Create plotting function
overdosePlot1 <- function(area = "United States") {
# Prep data
vv <- as.Date(c("2016-01-01","2017-01-01","2018-01-01",
"2019-01-01","2020-01-01","2021-01-01"))
xx <- dd %>% filter(Outcome == "Drug Overdose") %>%
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
mp <- overdosePlot1(area = "United States")
ggsave("usa_overdoses_1_01.png", mp, width = 6, height = 4)All States
mp <- overdosePlot1(area = unique(dd$Area))
ggsave("usa_overdoses_1_02.png", mp, width = 20, height = 10)Arizona
California
mp <- overdosePlot1(area = "California")
ggsave("usa_overdoses_1_04.png", mp, width = 6, height = 4)Colorado
New York
Yearly Deaths
Plotting Function
# Create plotting function
overdosePlot2 <- function(area = "United States") {
# Prep data
xx <- dd %>%
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")))
myCols <- c(alpha("darkred",0.3), alpha("darkred",0.6))
# 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
mp <- overdosePlot2(area = "United States")
ggsave("usa_overdoses_2_01.png", mp, width = 6, height = 4)All States
mp <- overdosePlot2(area = unique(dd$Area))
ggsave("usa_overdoses_2_02.png", mp, width = 20, height = 10)Arizona
California
mp <- overdosePlot2(area = "California")
ggsave("usa_overdoses_2_04.png", mp, width = 6, height = 4)Colorado
New York
Weekly Deaths
Plotting Function
# Create plotting function
overdosePlot2 <- function(area = "Alaska") {
# Prep data
colors <- c("darkred", "darkorange", "darkgreen")
vv <- as.Date(c("2016-01-01","2017-01-01","2018-01-01",
"2019-01-01","2020-01-01","2021-01-01"))
xx <- dd %>%
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
mp <- overdosePlot2(area = "United States")
ggsave("usa_overdoses_3_01.png", mp, width = 6, height = 4)All States
mp <- overdosePlot2(area = unique(dd$Area))
ggsave("usa_overdoses_3_02.png", mp, width = 20, height = 10)Arizona
California
mp <- overdosePlot2(area = "California")
ggsave("usa_overdoses_3_04.png", mp, width = 6, height = 4)Colorado
New York
