Overdose Deaths In Canada
Graphs of yearly overdose deaths in Canada using GOV CA, SK & BC data
Data
Health Canada Data
BC Coroners Service
Alberta Health Services
SK Coroners Service
All Data
Prepare Data
# devtools::install_github("derekmichaelwright/agData")
library(agData)
library(readxl)
library(gganimate)
#
# Prep CA data
#
<- "www.dblogr.com/ or derekmichaelwright.github.io/dblogr/ | Data: CA GOV\nNote: most recent years data may be incomplete"
myCaptionCA <- c("palevioletred3", "steelblue")
myColorsMF <- read_xlsx("data_canada_overdoses.xlsx", "Canada") %>%
ca1 mutate(Area = factor(Area, levels = agData_STATCAN_Region_Table$Area))
#
# Prep BC data
#
<- "www.dblogr.com/ or derekmichaelwright.github.io/dblogr/ | Data: BC GOV\nNote: most recent years data may be incomplete"
myCaptionBC #
<- read_xlsx("data_canada_overdoses.xlsx", "BC Annual")
bc1 #
<- read_xlsx("data_canada_overdoses.xlsx", "BC Monthly") %>%
bc2 gather(Year, Deaths, 2:12) %>%
mutate(Date = as.Date(paste(Year, Month, "15", sep = "-"),
format = "%Y-%b-%d"))
#
<- read_xlsx("data_canada_overdoses.xlsx", "BC Sex") %>%
bc3 gather(Sex, Deaths, Female, Male)
#
<- read_xlsx("data_canada_overdoses.xlsx", "BC Age") %>%
bc4 gather(Year, Deaths, 2:12) %>%
mutate(Year = as.numeric(Year),
`Age Group` = factor(`Age Group`, levels = unique(.$`Age Group`)))
#
# Prep AB data
#
<- "www.dblogr.com/ or derekmichaelwright.github.io/dblogr/ | Data: AB GOV\nNote: most recent years data may be incomplete"
myCaptionAB #
<- read_xlsx("data_canada_overdoses.xlsx", "AB Monthly") %>%
ab1 mutate(Date = as.Date(paste(Year, Month, "15", sep = "-"),
format = "%Y-%b-%d") )
#
# Prep SK data
#
<- "www.dblogr.com/ or derekmichaelwright.github.io/dblogr/ | Data: SK GOV\nNote: most recent years data may be incomplete"
myCaptionSK <- c("Unknown", "Other", "Hispanic","Black", "Asian",
myRaces "Metis","First Nations", "Caucasian")
#
<- read_xlsx("data_canada_overdoses.xlsx", "SK Annual")
sk1 #
<- read_xlsx("data_canada_overdoses.xlsx", "SK Meth")
sk2 #
<- read_xlsx("data_canada_overdoses.xlsx", "SK Age") %>%
sk3 gather(Year, Deaths, 3:ncol(.)) %>%
mutate(Year = as.numeric(Year))
#
<- read_xlsx("data_canada_overdoses.xlsx", "SK Race") %>%
sk4 gather(Year, Deaths, 3:ncol(.)) %>%
mutate(Year = as.numeric(Year),
Race = factor(Race, levels = myRaces))
Canada
# Prep data
<- ca1 %>% filter(Area == "Canada")
xx # Plot
<- ggplot(xx, aes(x = Year, y = Number / 1000)) +
mp geom_col(fill = "darkred", color = "black", alpha = 0.7) +
scale_x_continuous(breaks = 2016:2022) +
theme_agData() +
labs(title = "Drug Overdoses in Canada",
x = NULL, y = "Thousand Deaths", caption = myCaptionCA)
ggsave("canada_overdoses_01.png", mp, width = 6, height = 4)
Provinces
# Prep data
<- ca1 %>% filter(Area != "Canada")
xx # Plot
<- ggplot(xx, aes(x = Year, y = Number)) +
mp geom_col(fill = "darkred", color = "black", alpha = 0.7) +
facet_wrap(Area ~ ., scales = "free_y") +
scale_x_continuous(breaks = 2016:2022) +
theme_agData(axis.text.x = element_text(angle = 45, hjust = 1)) +
labs(title = "Drug Overdoses in Canada",
x = NULL, y = "Deaths", caption = myCaptionCA)
ggsave("canada_overdoses_02.png", mp, width = 10, height = 6)
British Columbia
Annual Drug Overdoses
Deaths
<- ggplot(bc1, aes(x = Year, y = Deaths)) +
mp geom_col(fill = "darkred", color = "black", alpha = 0.7) +
scale_x_continuous(breaks = seq(1995, 2020, by = 5),
minor_breaks = 1990:2025) +
theme_agData() +
labs(title = "Drug Overdoses in British Columbia", x = NULL,
caption = myCaptionBC)
ggsave("british_columbia_overdoses_01.png", mp, width = 6, height = 4)
Rate
<- ggplot(bc1, aes(x = Year, y = Rate)) +
mp geom_line(color = "darkred", alpha = 0.7, size = 1) +
geom_point(alpha = 0.7) +
geom_label_repel(data = bc1 %>% filter(Year %in% c(2008,2021)),
aes(label = Rate)) +
scale_x_continuous(minor_breaks = 1990:2025) +
theme_agData() +
labs(title = "Drug Overdoses in British Columbia",
y = "Deaths per 100,000 people", x = NULL,
caption = myCaptionBC)
ggsave("british_columbia_overdoses_02.png", mp, width = 6, height = 4)
Monthly Drug Overdoses
<- ggplot(bc2, aes(x = Date, y = Deaths)) +
mp geom_col(fill = "darkred", color = "black", lwd = 0.2, alpha = 0.7) +
geom_vline(xintercept = as.Date(paste0(2011:2022,"-01-01")),
alpha = 0.5, lty = 2) +
scale_x_date(date_breaks = "year", date_labels = "%Y") +
theme_agData() +
labs(title = "Drug Overdoses in British Columbia", x = NULL,
caption = myCaptionBC)
ggsave("british_columbia_overdoses_03.png", mp, width = 7, height = 4)
> 2019
<- ggplot(bc2 %>% filter(Year >= 2019), aes(x = Date, y = Deaths)) +
mp geom_col(fill = "darkred", color = "black", lwd = 0.5, alpha = 0.7) +
geom_vline(xintercept = as.Date(paste0(2011:2022,"-01-01")),
alpha = 0.5, lty = 2) +
scale_x_date(date_breaks = "year", date_labels = "%Y") +
theme_agData() +
labs(title = "Drug Overdoses in British Columbia", x = NULL,
caption = myCaptionBC)
ggsave("british_columbia_overdoses_04.png", mp, width = 6, height = 4)
By Sex
<- ggplot(bc3, aes(x = Year, y = Deaths, fill = Sex)) +
mp geom_col(position = "dodge", color = "black", alpha = 0.7) +
scale_fill_manual(name = NULL, values = myColorsMF) +
scale_x_continuous(breaks = 2011:2022) +
scale_y_continuous(breaks = seq(0, 1500, by = 500), limits = c(0,1800)) +
theme_agData(legend.position = "bottom") +
labs(title = "Drug Overdoses in British Columbia", x = NULL,
caption = myCaptionBC)
ggsave("british_columbia_overdoses_05.png", mp, width = 6, height = 4)
By Age Group
Animation
<- ggplot(bc4, aes(x = `Age Group`, y = Deaths, fill = `Age Group`)) +
mp geom_col(position = "dodge", color = "black", fill = "darkred", alpha = 0.7) +
theme_agData(legend.position = "none") +
labs(title = "Drug Overdoses in British Columbia - {round(frame_time)}",
caption = myCaptionBC) +
transition_time(Year)
anim_save("british_columbia_overdoses_gif_01.gif", mp,
nframes = 300, fps = 30, end_pause = 30,
width = 900, height = 600, res = 150)
2011 - 2016 - 2017 - 2021
# Prep data
<- bc4 %>% filter(Year %in% c(2011, 2016, 2017, 2021))
xx # Plot
<- ggplot(xx, aes(x = `Age Group`, y = Deaths)) +
mp geom_col(position = "dodge", color = "black", fill = "darkred", alpha = 0.7) +
facet_grid(. ~ Year) +
theme_agData(legend.position = "none",
axis.text.x = element_text(angle = 45, hjust = 1)) +
labs(title = "Drug Overdoses in British Columbia", x = NULL,
caption = myCaptionBC)
ggsave("british_columbia_overdoses_06.png", mp, width = 9, height = 4)
Unscaled
<- ggplot(bc4, aes(x = Year, y = Deaths)) +
mp geom_col(position = "dodge", color = "black", fill = "darkred", alpha = 0.7) +
facet_grid(. ~ paste("Ages",`Age Group`)) +
scale_x_continuous(breaks = c(2013, 2019), minor_breaks = 2011:2021) +
theme_agData(legend.position = "none") +
labs(title = "Drug Overdoses in British Columbia", x = NULL,
caption = myCaptionBC)
ggsave("british_columbia_overdoses_07.png", mp, width = 12, height = 4)
Scaled
<- ggplot(bc4, aes(x = Year, y = Deaths)) +
mp geom_col(position = "dodge", color = "black", fill = "darkred", alpha = 0.7) +
facet_wrap(. ~ paste("Ages",`Age Group`), scales = "free_y", ncol = 7) +
scale_x_continuous(breaks = c(2013, 2019), minor_breaks = 2011:2021) +
theme_agData(legend.position = "none") +
labs(title = "Drug Overdoses in British Columbia",
x = NULL, caption = myCaptionBC)
ggsave("british_columbia_overdoses_08.png", mp, width = 12, height = 4)
Alberta
Monthly Drug Overdoses
Number
<- ggplot(ab1, aes(x = Date, y = Number)) +
mp geom_col(color = "black", lwd = 0.3, fill = "darkred", alpha = 0.7) +
geom_vline(xintercept = as.Date(paste0(2016:2023,"-01-01")),
alpha = 0.5, lty = 2) +
theme_agData() +
labs(title = "Drug Overdoses in Alberta",
x = NULL, caption = myCaptionAB)
ggsave("alberta_overdoses_01.png", mp, width = 7, height = 4)
Rate
<- ggplot(ab1, aes(x = Date, y = Rate)) +
mp geom_col(color = "black", lwd = 0.3, fill = "darkred", alpha = 0.7) +
geom_vline(xintercept = as.Date(paste0(2016:2023,"-01-01")),
alpha = 0.5, lty = 2) +
theme_agData() +
labs(title = "Drug Overdoses in Alberta", x = NULL,
y = "Rate per 100,000", caption = myCaptionAB)
ggsave("alberta_overdoses_02.png", mp, width = 7, height = 4)
Saskatchewan
Annual Drug Overdoses
<- ggplot(sk1, aes(x = Year, y = Accident)) +
mp geom_col(color = "black", fill = "darkred", alpha = 0.7) +
scale_x_continuous(breaks = 2010:max(sk1$Year),
minor_breaks = 2010:max(sk1$Year)) +
theme_agData() +
labs(title = "Drug Overdoses in Saskatchewan",
y = "Deaths", x = NULL, caption = myCaptionSK)
ggsave("saskatchewan_overdoses_01.png", mp, width = 6, height = 4)
By Sex
# Prep data
<- sk3 %>%
xx group_by(Year, Sex) %>%
summarise(Deaths = sum(Deaths))
# Plot
<- ggplot(xx, aes(x = Year, y = Deaths, fill = Sex)) +
mp geom_col(position = "dodge", color = "black", alpha = 0.7) +
scale_fill_manual(name = NULL, values = myColorsMF) +
scale_x_continuous(breaks = 2010:max(xx$Year),
minor_breaks = 2010:max(xx$Year)) +
theme_agData(legend.position = "bottom") +
labs(title = "Drug Overdoses in Saskatchewan",
x = NULL, caption = myCaptionSK)
ggsave("saskatchewan_overdoses_03.png", mp, width = 6, height = 4)
Age Group
<- ggplot(sk3, aes(x = Year, y = Deaths, fill = Sex)) +
mp geom_col(color = "black", lwd = 0.3, alpha = 0.7) +
facet_grid(. ~ `Age Group`) +
scale_x_continuous(breaks = c(2013, 2019),
minor_breaks = 2010:max(sk3$Year)) +
scale_fill_manual(name = NULL, values = myColorsMF) +
theme_agData(legend.position = "bottom") +
labs(title = "Drug Overdoses in Saskatchewan",
x = NULL, caption = myCaptionSK)
ggsave("saskatchewan_overdoses_04.png", mp, width = 12, height = 4)
By Sex
<- ggplot(sk3, aes(x = Year, y = Deaths, fill = Sex)) +
mp geom_col(position = "dodge", color = "black", lwd = 0.3, alpha = 0.8) +
facet_grid(Sex ~ `Age Group`) +
scale_x_continuous(breaks = c(2013, 2019),
minor_breaks = 2010:max(sk3$Year)) +
scale_fill_manual(name = NULL, values = myColorsMF) +
theme_agData(legend.position = "none") +
labs(title = "Drug Overdoses in Saskatchewan",
x = NULL, caption = myCaptionSK)
ggsave("saskatchewan_overdoses_05.png", mp, width = 12, height = 6)
Animation
<- ggplot(sk3, aes(x = `Age Group`, y = Deaths, fill = Sex)) +
mp geom_col(position = "dodge", color = "black", alpha = 0.8) +
scale_fill_manual(name = NULL, values = myColorsMF) +
theme_agData(legend.position = "bottom") +
labs(title = "Drug Overdoses in Saskatchewan - {round(frame_time)}",
x = NULL, caption = myCaptionSK) +
transition_time(Year)
anim_save("saskatchewan_overdoses_gif_01.gif", mp,
nframes = 300, fps = 30, end_pause = 30,
width = 900, height = 600, res = 150)
2021
<- ggplot(sk3 %>% filter(Year == 2021),
mp aes(x = `Age Group`, y = Deaths, fill = Sex)) +
geom_col(position = "dodge", color = "black", alpha = 0.8) +
scale_fill_manual(name = NULL, values = myColorsMF) +
theme_agData(legend.position = "bottom") +
labs(title = "Drug Overdoses in Saskatchewan - 2021",
x = NULL, caption = myCaptionSK)
ggsave("saskatchewan_overdoses_06.png", mp, width = 6, height = 4)
2010 - 2015 - 2019 - 2020
By Year
<- ggplot(sk3 %>% filter(Year %in% c(2010,2015,2019,2021)),
mp aes(x = `Age Group`, y = Deaths, fill = Sex)) +
geom_col(position = "dodge", color = "black", alpha = 0.8) +
facet_grid(. ~ Year) +
scale_fill_manual(name = NULL, values = myColorsMF) +
theme_agData(legend.position = "bottom",
axis.text.x = element_text(angle = 45, hjust = 1)) +
labs(title = "Drug Overdoses in Saskatchewan",
x = NULL, caption = myCaptionSK)
ggsave("saskatchewan_overdoses_07.png", mp, width = 8, height = 4)
By Sex
# Prep data
<- sk3 %>% filter(Year %in% c(2010, 2015, 2019, 2021))
xx <- c(alpha("darkred",0.1), alpha("darkred",0.3),
myColors alpha("darkred",0.6), alpha("darkred",0.9))
# Plot
<- ggplot(xx, aes(x = `Age Group`, y = Deaths, fill = factor(Year))) +
mp geom_col(position = "dodge", color = "black") +
facet_grid(. ~ Sex) +
scale_fill_manual(name = NULL, values = myColors) +
theme_agData(legend.position = "bottom",
axis.text.x = element_text(angle = 45, hjust = 1)) +
labs(title = "Drug Overdoses in Saskatchewan",
x = NULL, caption = myCaptionSK)
ggsave("saskatchewan_overdoses_08.png", mp, width = 8, height = 4)
By Race
<- ggplot(sk4, aes(x = Year, y = Deaths, fill = Sex)) +
mp geom_col(color = "black", lwd = 0.3, alpha = 0.8) +
facet_grid(. ~ Race) +
scale_x_continuous(breaks = c(2013, 2019), minor_breaks = 2010:2021) +
scale_fill_manual(name = NULL, values = myColorsMF) +
theme_agData(legend.position = "bottom") +
labs(title = "Drug Overdoses in Saskatchewan",
x = NULL, caption = myCaptionSK)
ggsave("saskatchewan_overdoses_09.png", mp, width = 12, height = 4)
By Sex
<- ggplot(sk4, aes(x = Year, y = Deaths, fill = Sex)) +
mp geom_col(position = "dodge", color = "black", lwd = 0.3, alpha = 0.8) +
facet_grid(Sex ~ Race) +
scale_x_continuous(breaks = c(2013, 2019), minor_breaks = 2010:2021) +
scale_fill_manual(name = NULL, values = myColorsMF) +
theme_agData(legend.position = "none") +
labs(title = "Drug Overdoses in Saskatchewan",
x = NULL, caption = myCaptionSK)
ggsave("saskatchewan_overdoses_10.png", mp, width = 12, height = 6)
2020
<- ggplot(sk4 %>% filter(Year == 2021),
mp aes(x = Race, y = Deaths, fill = Sex)) +
geom_col(position = "dodge", color = "black", alpha = 0.8) +
scale_fill_manual(name = NULL, values = myColorsMF) +
theme_agData(legend.position = "bottom") +
labs(title = "Drug Overdoses in Saskatchewan - 2021",
x = NULL, caption = myCaptionSK)
ggsave("saskatchewan_overdoses_11.png", mp, width = 6, height = 4)
Animation
<- ggplot(sk4, aes(x = Race, y = Deaths, fill = Sex)) +
mp geom_col(position = "dodge", color = "black", alpha = 0.8) +
scale_fill_manual(name = NULL, values = myColorsMF) +
theme_agData(legend.position = "bottom") +
labs(title = "Drug Overdoses in Saskatchewan - {round(frame_time)}",
caption = myCaptionSK) +
transition_time(Year)
anim_save("saskatchewan_overdoses_gif_02.gif", mp,
nframes = 300, fps = 30, end_pause = 30,
width = 900, height = 600, res = 150)
2010 - 2015 - 2019 - 2021
# Prep data
<- sk4 %>% filter(Year %in% c(2010, 2015, 2019, 2021),
xx %in% c("First Nations", "Caucasian"))
Race <- c(alpha("darkred",0.1), alpha("darkred",0.3),
myColors alpha("darkred",0.6), alpha("darkred",0.9))
# Plot
<- ggplot(xx, aes(x = Race, y = Deaths, fill = factor(Year))) +
mp geom_col(position = "dodge", color = "black") +
facet_grid(. ~ Sex) +
scale_fill_manual(name = NULL, values = myColors) +
theme_agData(legend.position = "bottom") +
labs(title = "Drug Overdoses in Saskatchewan - 2010 vs. 2019 vs. 2021",
x = NULL, caption = myCaptionSK)
ggsave("saskatchewan_overdoses_12.png", mp, width = 6, height = 4)
Rate
# Prep data
<- agData_STATCAN_Population %>%
pop_FN filter(Area == "Saskatchewan", Month == 1, Year == 2021) %>%
pull(Value) * 0.107
<- agData_STATCAN_Population %>%
pop_CN filter(Area == "Saskatchewan", Month == 1, Year == 2021) %>%
pull(Value) * 0.728
<- sk4 %>%
xx filter(Year %in% c(2019, 2021),
%in% c("First Nations", "Caucasian")) %>%
Race mutate(Rate = ifelse(Race == "Caucasian",
/ pop_CN * 100000,
Deaths / pop_FN * 100000))
Deaths <- c(alpha("darkred",0.3), alpha("darkred",0.7))
myColors # Plot
<- ggplot(xx, aes(x = Race, y = Rate, fill = factor(Year))) +
mp geom_col(position = "dodge",
color = "black") +
facet_grid(. ~ Sex) +
scale_fill_manual(name = NULL, values = myColors) +
theme_agData(legend.position = "bottom") +
labs(title = "Drug Overdose Rates in Saskatchewan - 2019 vs. 2020",
y = "Deaths per 100,000 people", x = NULL, caption = myCaptionSK)
ggsave("saskatchewan_overdoses_13.png", mp, width = 6, height = 4)
Fold Increase
# Prep data
<- sk4 %>%
xx filter(Year %in% c(2010, 2019, 2021),
%in% c("First Nations", "Caucasian")) %>%
Race spread(Year, Deaths) %>%
mutate(`2021 / 2010` = `2021` / `2010`,
`2021 / 2019` = `2021` / `2019`) %>%
gather(Trait, Value, `2021 / 2010`, `2021 / 2019`)
# Plot
<- ggplot(xx, aes(x = Race, y = Value, fill = Sex)) +
mp geom_col(position = "dodge", color = "black", alpha = 0.7) +
facet_wrap(. ~ Trait, scales = "free_y") +
scale_fill_manual(name = NULL, values = myColorsMF) +
scale_y_continuous(minor_breaks = 0:18) +
theme_agData(legend.position = "bottom") +
labs(title = "Drug Overdoses in Saskatchewan - 2019 vs. 2020",
y = "Fold Increase", x = NULL, caption = myCaptionSK)
ggsave("saskatchewan_overdoses_14.png", mp, width = 6, height = 4)