Data608_Story3
2026-03-11
Data 608 : Story 3
DO STRICTER FIREARM LAWS REDUCE MORTALITY?
PAL <- list(
bg = "#0F1923",
panel = "#182533",
grid = "#1E3042",
text = "#E8DCC8",
subtext = "#8A9BAD",
mortality = "#C0392B",
mortality_lo = "#E8A090",
strict = "#1ABC9C",
strict_lo = "#A8E6DC",
accent = "#F39C12",
neutral = "#4A6278"
)
# Mortality colors
MORT_BINS <- c("#F4C2B8", "#E88A7A", "#D4523C", "#B82818", "#7A0A04")
MORT_LABS <- c("Very Low", "Low", "Moderate", "High", "Very High")
# Law colors
LAW_BINS <- c("#C8F0EA", "#7ED8CC", "#35B8A6", "#1A8A7A", "#0A5248")
LAW_LABS <- c("1 · Very Lax", "2 · Lax", "3 · Moderate",
"4 · Strict", "5 · Very Strict")
FONT_TITLE <- "Georgia"
FONT_BODY <- "Courier"
theme_firearm <- function(base_size = 12) {
theme_minimal(base_size = base_size) %+replace%
theme(
plot.background = element_rect(fill = PAL$bg, color = NA),
panel.background = element_rect(fill = PAL$panel, color = NA),
panel.grid.major = element_line(color = PAL$grid, linewidth = 0.4),
panel.grid.minor = element_blank(),
plot.title = element_text(family = FONT_TITLE, face = "bold",
color = PAL$text, size = base_size * 1.5,
margin = margin(b = 6)),
plot.subtitle = element_text(family = FONT_BODY, color = PAL$subtext,
size = base_size * 0.9,
margin = margin(b = 12)),
plot.caption = element_text(family = FONT_BODY, color = PAL$subtext,
size = base_size * 0.7, hjust = 1),
axis.title = element_text(family = FONT_BODY, color = PAL$subtext,
size = base_size * 0.85),
axis.text = element_text(family = FONT_BODY, color = PAL$subtext,
size = base_size * 0.8),
legend.background = element_rect(fill = PAL$panel, color = NA),
legend.text = element_text(family = FONT_BODY, color = PAL$subtext),
legend.title = element_text(family = FONT_BODY, color = PAL$text,
face = "bold"),
legend.key = element_rect(fill = PAL$panel, color = NA),
plot.margin = margin(16, 20, 12, 16),
strip.text = element_text(family = FONT_BODY, color = PAL$text,
face = "bold")
)
}Data wrangling
firearm_raw <- read_csv("Provisional Mortality Statistics, 2018 through Last Week.csv")
firearm <- firearm_raw %>%
select(state = "Residence State", rate = "Crude Rate") %>%
mutate(state_abbr = state.abb[match(state, state.name)]) %>%
filter(!is.na(state_abbr), !is.na(rate))
gun_laws <- read_csv("state_gun_law_strictness.csv")
combined <- firearm %>%
left_join(gun_laws, by = "state") %>%
filter(!is.na(law_numeric), !is.na(rate)) %>%
mutate(
likert_label = case_when(
law_score == 1 ~ "1 · Very Lax",
law_score == 2 ~ "2 · Lax",
law_score == 3 ~ "3 · Moderate",
law_score == 4 ~ "4 · Strict",
law_score == 5 ~ "5 · Very Strict",
TRUE ~ as.character(law_score)
),
likert_label = factor(likert_label, levels = LAW_LABS),
mort_bin = cut(rate,
breaks = quantile(rate, probs = seq(0, 1, 0.2), na.rm = TRUE),
labels = MORT_LABS,
include.lowest = TRUE),
mort_bin = factor(mort_bin, levels = MORT_LABS)
)
# State label centers (base R — no maps:: prefix needed)
state_centers <- tibble(
state_abbr = state.abb,
x = state.center$x,
y = state.center$y
)Heatmap : Mortality
us_states <- map_data("state") %>% mutate(state = str_to_title(region))
map_data_full <- us_states %>% left_join(combined, by = "state")
p2 <- ggplot(map_data_full, aes(long, lat, group = group)) +
geom_polygon(aes(fill = mort_bin), color = PAL$bg, linewidth = 0.25) +
geom_text(
data = combined %>% left_join(state_centers, by = "state_abbr"),
aes(x = x, y = y, label = state_abbr, group = NULL),
color = PAL$bg, size = 2.2, fontface = "bold", family = FONT_BODY
) +
coord_map("albers", lat0 = 30, lat1 = 45) +
scale_fill_manual(
values = setNames(MORT_BINS, MORT_LABS),
name = "Mortality\nLevel",
drop = FALSE,
na.translate = FALSE
) +
labs(
title = "Firearm Deaths Cluster in the South East and North Mountain West",
subtitle = "The pattern is geographic, not random."
) +
theme_firearm(base_size = 13) +
theme(axis.text = element_blank(),
axis.title = element_blank(),
panel.grid = element_blank())
ggsave("slide2_mortality_map.png", p2,
width = 11, height = 6.5, dpi = 180, bg = PAL$bg)
message("✓ Slide 2 saved")
p2
Heatmap : Law score
high_mort_states <- c("Montana", "Wyoming", "New Mexico", "Missouri",
"Arkansas", "Louisiana", "Mississippi", "Alabama", "Tennessee")
high_mort_borders <- us_states %>%
filter(state %in% high_mort_states)
p3 <- ggplot(map_data_full, aes(long, lat, group = group)) +
geom_polygon(aes(fill = likert_label), color = PAL$bg, linewidth = 0.25) +
# crimson border overlay
geom_polygon(data = high_mort_borders,
aes(long, lat, group = group),
fill = NA, color = PAL$mortality, linewidth = 0.9,
inherit.aes = FALSE) +
geom_text(
data = combined %>% left_join(state_centers, by = "state_abbr"),
aes(x = x, y = y, label = state_abbr, group = NULL),
color = PAL$bg, size = 2.2, fontface = "bold", family = FONT_BODY
) +
coord_map("albers", lat0 = 30, lat1 = 45) +
scale_fill_manual(
values = setNames(LAW_BINS, LAW_LABS),
name = "Law\nStrictness",
drop = FALSE,
na.translate = FALSE
) +
labs(
title = "Highest mortality rates mostly occur where Laws are most lax",
subtitle = "Crimson borders = Highest firearm mortality. Very clear Inverse geographic pattern"
) +
theme_firearm(base_size = 13) +
theme(axis.text = element_blank(),
axis.title = element_blank(),
panel.grid = element_blank())
ggsave("slide3_law_map.png", p3,
width = 11, height = 6.5, dpi = 180, bg = PAL$bg)
message("✓ Slide 3 saved")
p3
Butterfly bar
n <- 5
bottom5 <- combined %>% arrange(law_numeric) %>% slice_head(n = n)
top5 <- combined %>% arrange(desc(law_numeric)) %>% slice_head(n = n)
butterfly <- bind_rows(
bottom5 %>% mutate(group = "5 Most Lax"),
top5 %>% mutate(group = "5 Strictest")
) %>%
arrange(rate) %>%
mutate(
state = factor(state, levels = rev(unique(state))),
mort_neg = -rate,
strict_pos = rescale(law_numeric,
to = c(1, max(rate, na.rm = TRUE) * 0.6))
)
x_breaks <- seq(-25, 25, by = 5)
p4 <- ggplot(butterfly, aes(y = state)) +
geom_col(aes(x = mort_neg), fill = PAL$mortality, width = 0.65, alpha = 0.9) +
geom_col(aes(x = strict_pos), fill = PAL$strict, width = 0.65, alpha = 0.9) +
geom_vline(xintercept = 0, color = PAL$text, linewidth = 0.6) +
geom_text(aes(x = mort_neg - 0.5, label = sprintf("%.1f", rate)),
hjust = 1, size = 2.8, family = FONT_BODY, color = PAL$text) +
geom_text(aes(x = strict_pos + 0.5, label = sprintf("%.1f", law_numeric)),
hjust = 0, size = 2.8, family = FONT_BODY, color = PAL$text) +
scale_x_continuous(
breaks = x_breaks,
labels = abs(x_breaks),
limits = c(min(butterfly$mort_neg) * 1.25,
max(butterfly$strict_pos) * 1.25)
)+
annotate("text", x = -18, y = n + 1.8,
label = "← Firearm Mortality\n (per 100,000)",
hjust = 1, family = FONT_BODY,
color = PAL$mortality, size = 3.2, fontface = "bold") +
annotate("text", x = 7, y = n - 1.8,
label = "Law Strictness →\n(scaled index)",
hjust = 0, family = FONT_BODY,
color = PAL$strict, size = 3.2, fontface = "bold") +
labs(
title = "Face to Face, the Contrast Is Undeniable",
subtitle = "The 5 strictest states vs. the 5 most lax : Mortality and Law score side by side.",
y = NULL, x = NULL
) +
theme_firearm(base_size = 13) +
theme(legend.position = "none",
panel.grid.major.y = element_blank())
ggsave("slide4_butterfly.png", p4,
width = 11, height = 7.5, dpi = 180, bg = PAL$bg)
message("✓ Slide 4 saved")
p4
Scatterplot
label_states <- combined %>%
filter(
state_abbr %in% c("MA", "NY", "CT","CA", "IL","ID", "SD", "AR", "MT", "MS")
)
p1 <- ggplot(combined, aes(x = law_numeric, y = rate)) +
geom_smooth(method = "lm", se = TRUE,
color = PAL$accent,
fill = PAL$accent,
alpha = 0.15,
linewidth = 1.2) +
geom_point(shape = 21, size = 4,
fill = PAL$neutral,
color = PAL$bg,
stroke = 0.5, alpha = 0.9) +
geom_label_repel(data = label_states,
aes(label = state_abbr),
family = FONT_BODY,
size = 3,
color = PAL$text,
fill = PAL$panel,
label.padding = unit(0.2, "lines"),
label.size = 0.3,
box.padding = 0.5,
max.overlaps = 20) +
labs(
title = "A Clear Pattern: Stricter Laws, Fewer Deaths",
subtitle = "Each point is a U.S. state. The trend is consistent across the full spectrum of gun law strictness.",
x = "Gun Law Strictness (0 - 100)",
y = "Firearm Mortality Rate (per 100,000)"
) +
theme_firearm(base_size = 13)
ggsave("slide1_scatter.png", p1,
width = 10, height = 6.5, dpi = 180, bg = PAL$bg)
message("✓ Slide 1 saved")
p1
Split bars
likert_summary <- combined %>%
group_by(likert_label) %>%
summarise(avg_rate = mean(rate, na.rm = TRUE),
n_states = n(),
.groups = "drop")
combined_ord <- combined %>%
arrange(likert_label, rate) %>%
group_by(likert_label) %>%
mutate(rank_in_group = row_number()) %>%
ungroup()
p5 <- ggplot(combined_ord, aes(x = likert_label, y = rate)) +
# tinted column background — law strictness hue per column
geom_tile(data = likert_summary,
aes(x = likert_label, y = avg_rate, fill = likert_label),
width = 0.88, height = max(combined$rate) * 1.1,
alpha = 0.18, inherit.aes = FALSE) +
# individual state dots — uniform color; y-position carries the story
geom_jitter(width = 0.18, size = 3.5, alpha = 0.80, stroke = 0,
color = PAL$text) +
# group average crossbar
geom_crossbar(data = likert_summary,
aes(x = likert_label, y = avg_rate,
ymin = avg_rate, ymax = avg_rate),
color = PAL$accent, linewidth = 0.9, width = 0.55,
fatten = 0, inherit.aes = FALSE) +
# avg label
geom_label(data = likert_summary,
aes(x = likert_label, y = avg_rate,
label = sprintf("avg %.1f", avg_rate)),
nudge_x = 0.38, size = 3, family = FONT_BODY,
fill = PAL$panel, color = PAL$accent,
label.size = 0.2, inherit.aes = FALSE) +
# n = X count at bottom
geom_text(data = likert_summary,
aes(x = likert_label, y = -1.2,
label = paste0("n = ", n_states)),
size = 2.8, family = FONT_BODY,
color = PAL$subtext, inherit.aes = FALSE) +
scale_fill_manual(values = setNames(LAW_BINS, LAW_LABS), guide = "none") +
scale_y_continuous(expand = expansion(mult = c(0.08, 0.06))) +
labs(
title = "Not just at the extremes : Every step up the scale saves lives.",
subtitle = "Average mortality falls at each Likert level. Halves at last step",
x = "Gun Law Strictness",
y = "Firearm Mortality Rate (per 100,000)"
) +
theme_firearm(base_size = 13) +
theme(legend.position = "none")
ggsave("slide5_heatmap_likert.png", p5,
width = 11, height = 6.5, dpi = 180, bg = PAL$bg)
message("✓ Slide 5 saved")
p5
Sources
CDC Provisional Mortality Statistics : Firearm mortality rate per 100,000 population by state · open.cdc.gov/apis.html State Gun Law Strictness Index : Gun law strength scores calculated across 50 key policies . https://everytownresearch.org/rankings/ Additional Gun law scorecard : https://giffords.org/lawcenter/resources/scorecard/ Centers for Disease Control and Prevention, National Center for Health Statistics. National Vital Statistics System, Provisional Mortality on CDC WONDER Online Database. http://wonder.cdc.gov/mcd-icd10-provisional.html