DATA 608 Story 3
Susanna Wong
2024-10-14
Story - 3 : Do stricter gun laws reduce firearm gun deaths?
This story explores whether stricter firearm control laws are linked to reduced firearm mortality rates in the United States. Using CDC data on firearm deaths per 100,000 people and categorizing states by the strictness of their gun laws, we will analyze the correlation between gun control policies and mortality rates. The findings will be presented through heatmaps to highlight any potential impact of stricter laws on reducing gun violence.
library(httr)
library(jsonlite)
library(dplyr)
library(stringr)
library(ggplot2)
library(tidyr)
library(viridis)
library(tigris)
library(sf)
response <- GET("https://data.cdc.gov/resource/489q-934x.json")
data <- as.data.frame(fromJSON(content(response, as = "text")))gun_mortality <- data %>%
filter(year_and_quarter == "2022 Q4",
time_period == "12 months ending with quarter",
cause_of_death == "Firearm-related injury",
rate_type == "Crude")state_abbr <- c(
"alaska" = "AK", "alabama" = "AL", "arkansas" = "AR", "arizona" = "AZ", "california" = "CA",
"colorado" = "CO", "connecticut" = "CT", "district_of_columbia" = "DC", "delaware" = "DE", "florida" = "FL",
"georgia" = "GA", "hawaii" = "HI", "iowa" = "IA", "idaho" = "ID", "illinois" = "IL", "indiana" = "IN",
"kansas" = "KS", "kentucky" = "KY", "louisiana" = "LA", "massachusetts" = "MA", "maryland" = "MD",
"maine" = "ME", "michigan" = "MI", "minnesota" = "MN", "missouri" = "MO", "mississippi" = "MS",
"montana" = "MT", "north_carolina" = "NC", "north_dakota" = "ND", "nebraska" = "NE", "new_hampshire" = "NH",
"new_jersey" = "NJ", "new_mexico" = "NM", "nevada" = "NV", "new_york" = "NY", "ohio" = "OH",
"oklahoma" = "OK", "oregon" = "OR", "pennsylvania" = "PA", "rhode_island" = "RI", "south_carolina" = "SC",
"south_dakota" = "SD", "tennessee" = "TN", "texas" = "TX", "utah" = "UT", "virginia" = "VA",
"vermont" = "VT", "washington" = "WA", "wisconsin" = "WI", "west_virginia" = "WV", "wyoming" = "WY"
)
# Rename columns based on the named vector
#gun_mortality <- gun_mortality %>%
# rename_with(~ str_replace_all(., "rate_", "") %>% # Remove "rate_"
# str_replace_all(state_abbr), # Replace state names with abbreviations
# starts_with("rate_"))
colnames(gun_mortality) <- gsub("^rate_", "", colnames(gun_mortality))gun_mortality <- gun_mortality %>%
select(-time_period, -year_and_quarter, -cause_of_death, -type, -unit, -overall, -sex_female, -sex_male, -age_1_4, -age_5_14, -age_15_24, -age_25_34, -age_35_44, -age_45_54, -age_55_64, -age_75_84, -age_85_plus, -district_of_columbia)
gun_mortality <- gun_mortality[,-ncol(gun_mortality)]
colnames(gun_mortality) <- gsub("_", " ", colnames(gun_mortality))
colnames(gun_mortality) <- tools::toTitleCase(colnames(gun_mortality))
gun_mortality_long <- gun_mortality %>%
pivot_longer(cols = Alaska:Wyoming, # Replace with your actual state column range
names_to = "state",
values_to = "mortality_rate")
gun_mortality_long$mortality_rate <- as.numeric(gun_mortality_long$mortality_rate)gun_laws <- read.csv("https://raw.githubusercontent.com/suswong/DATA-608/refs/heads/main/strictest-gun-laws-by-state-2024.csv")
merged_data <- merge(gun_mortality_long, gun_laws, by = "state")Gun Law Strictness v. Firearm Mortality Deaths Per 100k
merged_data <- merged_data %>%
mutate(numeric_score = case_when(
str_detect(GunLawsGiffordGrade, "^A") ~ 5, # Matches "A", "A-", "A+"
str_detect(GunLawsGiffordGrade, "^B") ~ 4, # Matches "B", "B-", "B+"
str_detect(GunLawsGiffordGrade, "^C") ~ 3, # Matches "C", "C-", "C+"
str_detect(GunLawsGiffordGrade, "^D") ~ 2, # Matches "D", "D-", "D+"
str_detect(GunLawsGiffordGrade, "^F") ~ 1 # Matches "F"
))
ggplot(merged_data, aes(x = numeric_score , y = mortality_rate)) +
geom_point() + # Add points
geom_smooth(method = "lm", se = FALSE, color = "blue") + # Add linear regression line
scale_x_continuous(breaks = 1:5, labels = c("A", "B", "C", "D", "F")) + # Set x-axis labels
labs(x = "Gifford Gun Law Grade (A = Strong, F = Weak)",
y = "Firearm Deaths Per 100k",
title = "On average, firearm related deaths are lower where there are stronger gun control laws") +
theme_minimal(base_size = 9) + # Set theme and base font size
theme(plot.title = element_text(hjust = 0)) # Align title to the left
suppressMessages({
us_states <- tigris::states(cb = TRUE, year = 2022) %>%
filter(STUSPS != "PR" & STUSPS != "HI" & STUSPS != "AK")
})##
|
| | 0%
|
| | 1%
|
|= | 1%
|
|= | 2%
|
|== | 3%
|
|== | 4%
|
|=== | 4%
|
|=== | 5%
|
|==== | 5%
|
|==== | 6%
|
|===== | 7%
|
|===== | 8%
|
|====== | 8%
|
|====== | 9%
|
|======= | 9%
|
|======= | 10%
|
|======== | 11%
|
|======== | 12%
|
|========= | 13%
|
|========= | 14%
|
|========== | 14%
|
|========== | 15%
|
|=========== | 15%
|
|=========== | 16%
|
|============ | 17%
|
|============ | 18%
|
|============= | 18%
|
|============= | 19%
|
|============== | 20%
|
|============== | 21%
|
|=============== | 21%
|
|=============== | 22%
|
|================ | 23%
|
|================= | 24%
|
|================= | 25%
|
|================== | 25%
|
|================== | 26%
|
|=================== | 27%
|
|=================== | 28%
|
|==================== | 28%
|
|==================== | 29%
|
|===================== | 30%
|
|===================== | 31%
|
|====================== | 31%
|
|====================== | 32%
|
|======================= | 33%
|
|======================== | 34%
|
|======================== | 35%
|
|========================= | 35%
|
|========================= | 36%
|
|========================== | 37%
|
|========================== | 38%
|
|=========================== | 38%
|
|=========================== | 39%
|
|============================ | 40%
|
|============================ | 41%
|
|============================= | 41%
|
|============================= | 42%
|
|============================== | 42%
|
|============================== | 43%
|
|=============================== | 44%
|
|=============================== | 45%
|
|================================ | 45%
|
|================================ | 46%
|
|================================= | 47%
|
|================================= | 48%
|
|================================== | 48%
|
|================================== | 49%
|
|=================================== | 50%
|
|=================================== | 51%
|
|==================================== | 51%
|
|==================================== | 52%
|
|===================================== | 52%
|
|===================================== | 53%
|
|====================================== | 54%
|
|====================================== | 55%
|
|======================================= | 55%
|
|======================================= | 56%
|
|======================================== | 57%
|
|======================================== | 58%
|
|========================================= | 58%
|
|========================================= | 59%
|
|========================================== | 60%
|
|=========================================== | 61%
|
|=========================================== | 62%
|
|============================================ | 62%
|
|============================================ | 63%
|
|============================================= | 64%
|
|============================================= | 65%
|
|============================================== | 65%
|
|============================================== | 66%
|
|=============================================== | 67%
|
|=============================================== | 68%
|
|================================================ | 68%
|
|================================================ | 69%
|
|================================================= | 69%
|
|================================================= | 70%
|
|================================================== | 71%
|
|================================================== | 72%
|
|=================================================== | 73%
|
|==================================================== | 74%
|
|==================================================== | 75%
|
|===================================================== | 75%
|
|===================================================== | 76%
|
|====================================================== | 77%
|
|======================================================= | 78%
|
|======================================================= | 79%
|
|======================================================== | 79%
|
|======================================================== | 80%
|
|========================================================= | 81%
|
|========================================================= | 82%
|
|========================================================== | 82%
|
|========================================================== | 83%
|
|=========================================================== | 84%
|
|=========================================================== | 85%
|
|============================================================ | 85%
|
|============================================================ | 86%
|
|============================================================= | 87%
|
|============================================================== | 88%
|
|============================================================== | 89%
|
|=============================================================== | 89%
|
|=============================================================== | 90%
|
|================================================================ | 91%
|
|================================================================ | 92%
|
|================================================================= | 92%
|
|================================================================= | 93%
|
|================================================================== | 94%
|
|================================================================== | 95%
|
|=================================================================== | 95%
|
|=================================================================== | 96%
|
|==================================================================== | 97%
|
|===================================================================== | 98%
|
|===================================================================== | 99%
|
|======================================================================| 99%
|
|======================================================================| 100%merged_data$state_lower <- toupper(merged_data$state)
score_data <- merged_data %>%
select(state, numeric_score, mortality_rate)
score_data <- score_data %>%
rename(NAME = state)
mortality_data <- merged_data %>%
select(state, mortality_rate) %>%
rename(NAME = state)
map_data_score <- us_states %>%
left_join(score_data, by = "NAME")
map_data_mortality <- us_states %>%
left_join(mortality_data, by = "NAME")Heatmap: Gun Law Strictness and Firearm Mortality Rate by State
ggplot(data = map_data_score) +
geom_sf(aes(fill = numeric_score), color = "white", size = 0.2) +
scale_fill_gradient(low = "#FFCCCC", high = "#990000", na.value = "grey90",
labels = c("1" = "Very Lax", "2" = "Lax", "3" = "Moderate", "4" = "Strict", "5" = "Very Strict"),
name = "Gun Law Strictness") +
geom_sf_text(aes(label = round(mortality_rate, 1)), size = 2, color = "black")+
labs(title = "Gun Law Strictness and Firearm Mortality Rate by State") +
theme_minimal() +
coord_sf(xlim = c(-125, -65), ylim = c(25, 50), expand = FALSE) +
theme(
axis.text = element_blank(),
axis.ticks = element_blank(),
axis.title = element_blank(),
panel.grid = element_blank()
)