library(tidyverse)
library(openintro)
library(httr)
library(jsonlite)
library(plotly)data608s3
Introduction
This analysis explores the relationship between firearm mortality rates and the strength of gun control laws across U.S. states. Data is sourced from the CDC (Centers for Disease Control and Prevention) and categorized based on the strictness of state gun laws. Goal is to present result through visualization with an aim to deliver a concise message.
Data Acquisition & Analysis process
# Set JSON data URL
url <- "https://data.cdc.gov/resource/489q-934x.json"
# Fetch JSON data by sending GET request
response_data <- GET(url)
# Parse JSON data to R list
list_data <- fromJSON(content(response_data, "text", encoding = "UTF-8"))
# Convert list to data frame
mortality_data <- as.data.frame(list_data) str(mortality_data)'data.frame': 756 obs. of 69 variables:
$ year_and_quarter : chr "2023 Q1" "2023 Q1" "2023 Q1" "2023 Q1" ...
$ time_period : chr "12 months ending with quarter" "12 months ending with quarter" "12 months ending with quarter" "12 months ending with quarter" ...
$ cause_of_death : chr "All causes" "Alzheimer disease" "COVID-19" "Cancer" ...
$ rate_type : chr "Age-adjusted" "Age-adjusted" "Age-adjusted" "Age-adjusted" ...
$ unit : chr "Deaths per 100,000" "Deaths per 100,000" "Deaths per 100,000" "Deaths per 100,000" ...
$ rate_overall : chr "763.6" "27.9" "19.6" "141.5" ...
$ rate_sex_female : chr "638.9" "31.4" "16.2" "123.6" ...
$ rate_sex_male : chr "908.8" "22.3" "24.5" "166" ...
$ rate_alaska : chr "808.5" "33.4" "18.7" "143.9" ...
$ rate_alabama : chr "944.7" "39.3" "22" "154.8" ...
$ rate_arkansas : chr "956.7" "39.3" "21.4" "167.9" ...
$ rate_arizona : chr "745.5" "28.1" "17.1" "130.8" ...
$ rate_california : chr "660.4" "36.2" "17.4" "129.3" ...
$ rate_colorado : chr "708.3" "30.7" "15.3" "123.5" ...
$ rate_connecticut : chr "686" "20.6" "20.8" "130.3" ...
$ rate_district_of_columbia: chr "749" "8.5" "15.2" "140.2" ...
$ rate_delaware : chr "794.4" "28.2" "18.3" "156.7" ...
$ rate_florida : chr "688.6" "16.3" "17.3" "135" ...
$ rate_georgia : chr "828.9" "38" "19.3" "146.4" ...
$ rate_hawaii : chr "605.4" "22.1" "11.2" "123.6" ...
$ rate_iowa : chr "772.8" "28.7" "19.5" "146" ...
$ rate_idaho : chr "740.1" "37.7" "15.7" "131.2" ...
$ rate_illinois : chr "743" "24.6" "16.9" "143.7" ...
$ rate_indiana : chr "875.3" "27" "21.6" "160.2" ...
$ rate_kansas : chr "828.2" "25.3" "22.1" "149" ...
$ rate_kentucky : chr "995.2" "27.1" "33.2" "177.6" ...
$ rate_louisiana : chr "932.2" "37.4" "18.2" "161.7" ...
$ rate_massachusetts : chr "673.2" "17.4" "19.1" "132.3" ...
$ rate_maryland : chr "712.1" "15.2" "18.1" "136" ...
$ rate_maine : chr "823.6" "24.5" "21.2" "153.1" ...
$ rate_michigan : chr "819.2" "32.1" "21.2" "152.3" ...
$ rate_minnesota : chr "687.8" "30.7" "17.3" "138.3" ...
$ rate_missouri : chr "873.3" "30.7" "21" "160" ...
$ rate_mississippi : chr "1012.1" "47.8" "24.8" "174.3" ...
$ rate_montana : chr "767.4" "23.1" "16.4" "144.5" ...
$ rate_north_carolina : chr "837.5" "32.3" "21" "149" ...
$ rate_north_dakota : chr "715.6" "31.8" "16.9" "130.7" ...
$ rate_nebraska : chr "748.5" "29.3" "17" "142.5" ...
$ rate_new_hampshire : chr "734.8" "24" "18.3" "140.1" ...
$ rate_new_jersey : chr "645.9" "17.6" "17.7" "124.4" ...
$ rate_new_mexico : chr "852.6" "25.9" "26.2" "126.7" ...
$ rate_nevada : chr "794.6" "24.4" "21" "139" ...
$ rate_new_york : chr "636.5" "11.4" "20.5" "121.6" ...
$ rate_ohio : chr "867.9" "31.5" "23.1" "155" ...
$ rate_oklahoma : chr "959.9" "32.2" "26.4" "167" ...
$ rate_oregon : chr "792" "36.7" "17.8" "144.4" ...
$ rate_pennsylvania : chr "780.6" "20.3" "21.3" "147.3" ...
$ rate_rhode_island : chr "689.7" "30.5" "14.3" "137" ...
$ rate_south_carolina : chr "875.2" "35.4" "21.4" "152.8" ...
$ rate_south_dakota : chr "760.7" "33.9" "18.3" "144.3" ...
$ rate_tennessee : chr "957.2" "33.8" "26.6" "163.7" ...
$ rate_texas : chr "772.8" "37.1" "18.8" "140.1" ...
$ rate_utah : chr "725.7" "38.8" "14.5" "117.2" ...
$ rate_virginia : chr "758.5" "23.4" "20.2" "143" ...
$ rate_vermont : chr "744.4" "33.8" "18.2" "146.1" ...
$ rate_washington : chr "738.9" "40" "16.9" "139.7" ...
$ rate_wisconsin : chr "759.6" "29.8" "16.7" "144.5" ...
$ rate_west_virginia : chr "1059.4" "26.7" "33.6" "174.6" ...
$ rate_wyoming : chr "796.9" "32.6" "19.7" "138.9" ...
$ rate_age_1_4 : chr NA NA NA NA ...
$ rate_age_5_14 : chr NA NA NA NA ...
$ rate_age_15_24 : chr NA NA NA NA ...
$ rate_age_25_34 : chr NA NA NA NA ...
$ rate_age_35_44 : chr NA NA NA NA ...
$ rate_age_45_54 : chr NA NA NA NA ...
$ rate_age_55_64 : chr NA NA NA NA ...
$ rate_65_74 : chr NA NA NA NA ...
$ rate_age_75_84 : chr NA NA NA NA ...
$ rate_age_85_plus : chr NA NA NA NA ...# Find the most recent complete quarter in the data
# Filter firearm-related cases
df_gun <- mortality_data |>
filter(
cause_of_death == "Firearm-related injury",
rate_type == "Crude",
time_period == "12 months ending with quarter"
)
# Create state abbreviations mapping
state_abbreviations <- c(
AL = "alabama", AK = "alaska", AZ = "arizona", AR = "arkansas",
CA = "california", CO = "colorado", CT = "connecticut", DE = "delaware",
FL = "florida", GA = "georgia", HI = "hawaii", ID = "idaho",
IL = "illinois", IN = "indiana", IA = "iowa", KS = "kansas",
KY = "kentucky", LA = "louisiana", ME = "maine", MD = "maryland",
MA = "massachusetts", MI = "michigan", MN = "minnesota", MS = "mississippi",
MO = "missouri", MT = "montana", NE = "nebraska", NV = "nevada",
NH = "new_hampshire", NJ = "new_jersey", NM = "new_mexico", NY = "new_york",
NC = "north_carolina", ND = "north_dakota", OH = "ohio", OK = "oklahoma",
OR = "oregon", PA = "pennsylvania", RI = "rhode_island", SC = "south_carolina",
SD = "south_dakota", TN = "tennessee", TX = "texas", UT = "utah",
VT = "vermont", VA = "virginia", WA = "washington", WV = "west_virginia",
WI = "wisconsin", WY = "wyoming", DC = "district_of_columbia"
)
# Rename state columns from full names to abbreviations
for (abbrev in names(state_abbreviations)) {
pattern <- paste0("rate_", state_abbreviations[abbrev])
colnames(df_gun) <- gsub(pattern, abbrev, colnames(df_gun))
}# Identify state columns
state_cols <- intersect(names(df_gun), names(state_abbreviations))
# Convert rate columns to numeric
df_gun <- df_gun |>
mutate(across(all_of(state_cols), .fns = as.numeric))
# Extract year and create long format
df_gun_long <- df_gun |>
mutate(
year = substr(year_and_quarter, 1, 4) %>% as.numeric(),
quarter = substr(year_and_quarter, 6, 7)
) |>
pivot_longer(
cols = all_of(state_cols),
names_to = "state",
values_to = "rate"
) |>
filter(!is.na(rate))
# Add gun law categories
final_df <- df_gun_long |>
select(year, quarter, year_and_quarter, state, rate) |>
mutate(
gun_laws = case_when(
# Category 1 - Most lax
state %in% c("AK", "AL", "AR", "AZ", "GA", "IA", "ID", "IN", "KS",
"KY", "LA", "ME", "MO", "MS", "MT", "ND", "NH", "OH",
"OK", "SC", "SD", "TN", "TX", "UT", "WV", "WY") ~ 1,
# Category 2 - Lax
state == "WI" ~ 2,
# Category 3 - Moderate
state %in% c("FL", "MI", "MN", "NC", "NE", "NM", "NV", "VT") ~ 3,
# Category 4 - Strict
state %in% c("CO", "DE", "OR", "PA", "RI", "VA", "WA") ~ 4,
# Category 5 - Most strict
state %in% c("CA", "CT", "DC", "HI", "IL", "MA", "MD", "NJ", "NY") ~ 5,
TRUE ~ NA_real_
)
) |>
filter(!is.na(gun_laws))
# Add factor for better labeling
final_df$gun_laws_factor <- factor(final_df$gun_laws, levels = 1:5,
labels = c("Most Lax", "Lax", "Moderate",
"Strict", "Most Strict"))# Get map data
us_map <- map_data("state")
# Create state name mapping (full names to abbreviations)
state_mapping <- data.frame(
state = c(state.abb, "DC"),
region = tolower(c(state.name, "district of columbia"))
)
# IMPORTANT: Use your actual data frame (final_df) not the map_data function
# Create a dataset for mapping with the most recent quarter
most_recent_q <- max(final_df$year_and_quarter, na.rm = TRUE)
map_data_df <- final_df %>%
filter(year_and_quarter == most_recent_q) %>%
select(state, gun_laws, rate) %>%
distinct()
# Now merge correctly
map_plot_data <- us_map %>%
left_join(state_mapping, by = "region") %>%
left_join(map_data_df, by = "state") # Use map_data_df, not map_data
# Law map
p1 <- ggplot() +
geom_polygon(data = map_plot_data,
aes(x = long, y = lat, group = group, fill = factor(gun_laws)),
color = "gray40", size = 0.2) +
coord_map(projection = "albers", lat0 = 30, lat1 = 40) +
scale_fill_manual(
values = c("1" = "#99c2a2", "2" = "#66a366", "3" = "#e6e600",
"4" = "#ffcc80", "5" = "#ff6666"),
labels = c("Most Lax", "Lax", "Moderate", "Strict", "Most Strict"),
name = "Gun Law Strength",
na.value = "gray90"
) +
theme_void() +
theme(
legend.position = "bottom",
plot.title = element_text(hjust = 0.5, face = "bold", size = 18),
legend.title = element_text(size = 12, face = "bold"),
legend.text = element_text(size = 10),
plot.margin = margin(20, 20, 20, 20)
) +
labs(title = paste("Gun Control Laws by State (", most_recent_q, ")", sep = ""))
# Display law map
print(p1)
# RATE MAP
p2 <- ggplot() +
geom_polygon(data = map_plot_data,
aes(x = long, y = lat, group = group, fill = rate),
color = "gray40", size = 0.2) +
coord_map(projection = "albers", lat0 = 30, lat1 = 40) +
scale_fill_gradient(
low = "#99c2a2", # Light green for low rates
high = "#ff6666", # Light red for high rates
name = "Mortality Rate\n(per 100,000)",
na.value = "gray90",
breaks = seq(0, 30, by = 5)
) +
theme_void() +
theme(
legend.position = "bottom",
plot.title = element_text(hjust = 0.5, face = "bold", size = 18),
legend.title = element_text(size = 12, face = "bold"),
legend.text = element_text(size = 10),
plot.margin = margin(20, 20, 20, 20)
) +
labs(title = "Firearm Mortality Rates by State (2024 Q4)")
# Display map
print(p2)
line_data <- final_df |>
filter(year_and_quarter == most_recent_q) |>
group_by(gun_laws) |>
summarise(
avg_rate = mean(rate, na.rm = TRUE),
se = sd(rate, na.rm = TRUE) / sqrt(n()),
count = n(),
.groups = "drop"
) |>
mutate(
category_label = case_when(
gun_laws == 1 ~ "Most Lax",
gun_laws == 2 ~ "Lax",
gun_laws == 3 ~ "Moderate",
gun_laws == 4 ~ "Strict",
gun_laws == 5 ~ "Most Strict"
),
category_label = factor(category_label,
levels = c("Most Lax", "Lax", "Moderate", "Strict", "Most Strict"))
)
line_plot_clean <- ggplot(line_data, aes(x = category_label, y = avg_rate, group = 1)) +
geom_line(color = "#ff6666", size = 1.5) +
geom_point(color = "#ff6666", size = 4) +
annotate("text",
x = 4.3,
y = mean(c(line_data$avg_rate[1], line_data$avg_rate[5])) ,
label = "↓ Lower mortality with stricter laws",
color = "#006600",
size = 4,
fontface = "bold",
angle = -30) +
labs(
title = "Firearm Mortality Rate by Gun Law Strictness",
subtitle = "States with stricter laws show lower mortality rates",
x = "Gun Law Strength Category",
y = "Average Mortality Rate (per 100,000)"
) +
theme_minimal() +
theme(
plot.title = element_text(hjust = 0.5, face = "bold", size = 16),
plot.subtitle = element_text(hjust = 0.5, size = 12, color = "gray30"),
axis.title = element_text(size = 12),
axis.text = element_text(size = 11),
panel.grid.minor = element_blank()
) +
scale_y_continuous(breaks = seq(0, max(line_data$avg_rate) + 2, by = 2))
line_plot_clean
Research Question: Do stricter firearm control laws help reduce firearm mortality?
The answer is Yes. After analyzing CDC firearm mortality data, our three plots combined together present a clear and consistent pattern: states with stricter gun control laws have substantially lower firearm mortality rates.
The first plot shows States with lax gun laws (green) cluster mostly in the South and Midwest. The second plot show the highest mortality rates (dark red) appear in nearly the exact same regions. The third plot line plot quantifies this conclusion, showing a steady decline in mortality rates as gun laws become stricter.