The CDC publishes firearm mortality for each State per 100,000 persons right on this CDC Link. Each State’ firearm control laws can be categorized as very strict to very lax.

The purpose of this Story is to answer the question, ‘Do stricter firearm control laws help reduce firearm mortality?’

Load Packages

# core packages
library(tidyverse)
library(fiftystater)
library(maps)
library(reshape2)
library(janitor)
library(viridis)
library(cowplot)

# data sourcing API packages 
library(jsonlite)
library(httr)
library(RSocrata)
library(rvest)
library(tidycensus)

Data Scraping and Pulling

# url link for data 
firearm_death_url <- 'https://data.cdc.gov/489q-934x'
gun_law_url <- 'https://giffords.org/lawcenter/resources/scorecard/'

# pulling and scraping data from websites associated with guns
cdc_gun_death_data <- read.socrata(firearm_death_url) %>% 
  filter(cause_of_death == 'Firearm-related injury' & 
           rate_type == 'Age-adjusted' & 
           time_period == '12 months ending with quarter' &
           year_and_quarter != '2024 Q1') %>%
  select(-c('unit','cause_of_death', 'rate_sex_female', 'rate_sex_male', 'rate_age_1_4', 
            'rate_age_5_14', 'rate_age_15_24', 'rate_age_25_34', 'rate_age_35_44',
            'rate_age_45_54', 'rate_age_55_64', 'rate_65_74', 'rate_age_75_84',
            'rate_age_85_plus'))

gun_law_html <- read_html(gun_law_url) %>% 
  html_nodes('table') %>% 
  html_table(header = TRUE, fill = TRUE)

gun_law_table <- gun_law_html[[1]] %>%
  tibble() %>%
  clean_names() %>%
  rename('State' = 'state')

# pulling total population from tidycensus
state_pop_census <- get_acs(
  geography = 'state',
  variables = 'B01003_001E',
  year = 2023,
  survey = 'acs1',
  resolution = '20m') %>% tibble() %>%
  select(-c(variable, moe))

Data Wrangling

# gun merge with score card and setting up the likert scale score 
# The score will be based on where 1 is the most loose (“F” grade) and 5 is the strictest (“A” grade)
gun_death_data2023 <- cdc_gun_death_data %>%
  melt(id = c('year_and_quarter', 'time_period', 'rate_type', 'rate_overall')) %>%
  mutate(variable = str_replace_all(variable, 'rate_', '')) %>%
  rename('State' = 'variable',
         'state_mortal_rate' = 'value') %>%
  mutate(State = str_replace_all(State, '_', ' '),
         State = str_to_title(State)) %>%
  left_join(gun_law_table, by = c('State' = 'State')) %>%
  filter(str_detect(year_and_quarter, '2023') & State != 'District Of Columbia') %>%
  mutate(likert_scale_score = case_when(
    str_detect(grade, 'A') ~ '5 (Most Strict)',
    str_detect(grade, 'B') ~ '4 (Strict)',
    str_detect(grade, 'C') ~ '3 (Moderate)',
    str_detect(grade, 'D') ~ '2 (Lenient)',
    TRUE ~ '1 (Most Lenient)'),
    state = tolower(State)) %>%
  left_join(state_pop_census, by = c('State' = 'NAME')) %>%
  select(-c(time_period, rate_type))

# get the average of firearm mortality rate per state
gun_death_average <- gun_death_data2023 %>%
  group_by(State) %>%
  summarise_at(vars(state_mortal_rate),
               list(state_average_mortal_rate = mean))

# combined two tables and create a matrix
gun_firearm_combined_data <- gun_death_data2023 %>%
  select(-c(year_and_quarter, rate_overall, state_mortal_rate)) %>%
  distinct(State, .keep_all = TRUE) %>%
  left_join(gun_death_average, by = c('State' = 'State')) %>%
  mutate(state_average_mortal_rate = round(state_average_mortal_rate, digits = 2))

# map data combined for us mapping
map_data_combined <- fifty_states %>%
  group_by(id) %>%
  summarise(lat = mean(c(max(lat), min(lat))),
            long = mean(c(max(long), min(long)))) %>%
  mutate(state = id) %>%
  left_join(gun_firearm_combined_data, by = "state") %>% 
  drop_na()

Overall Analysis and Data Visualization

par(mfrow = c(1,2))

# heat map on gun Law strength
gun_law_strength_heat_map <- gun_firearm_combined_data %>%
  ggplot(aes(x = factor(likert_scale_score), y = reorder(State, gun_law_strength_ranked))) +
  geom_tile(aes(fill = likert_scale_score), color="white") +
  scale_fill_viridis(discrete = TRUE, option = "plasma") +
  geom_text(aes(label = gun_law_strength_ranked), size = 1.5) +
  theme_minimal() +
  ggtitle("Gun Law Strength Ranked") +
  xlab("Likert Scale Score") +
  ylab("State") +
  theme(legend.position = "none")

# likert scale score
usa_firearm_mortal_heat_map <- map_data_combined %>%
  ggplot(aes(map_id = state)) +
  geom_map(aes(fill = likert_scale_score), color = 'black', map = fifty_states) +
  geom_text(aes(x = long, y = lat, label = state_average_mortal_rate), size = 1.5) +
  theme_void() +
  facet_wrap(~ likert_scale_score) +
  expand_limits(x = fifty_states$long, y = fifty_states$lat) +
  geom_map(aes(map_id = state), map = fifty_states, fill = NA, size = 1) +
  ggtitle("Average Firearm Mortality Rate Per 100K under Likert Scale Score in 2023") +
  theme(
    legend.title = element_text(face = 'bold', hjust = 0.5), 
    legend.title.align = 0.5, 
    legend.position = 'none',  
    legend.box = 'vertical'
  ) +
  scale_x_continuous(breaks = NULL) + 
  scale_y_continuous(breaks = NULL)

gun_law_strength_heat_map

usa_firearm_mortal_heat_map

With the CDC data on gun deaths and the Giffords data on gun control laws, it shows that stricter firearm control laws help reduce firearm mortality. Using the likert scale score of gun control laws in 2023 where the score will be based on where 1 is the most lenient (“F” grade) and 5 is the strictest (“A” grade), it clearly shows that firearm mortality rate is lower in stricter gun laws states compared to states with more lenient gun laws. The first heat map demonstrates the ranked gun law strength under the likert scale score in 2023. The second heat map shows the average firearm mortality rate under the scale in 2023. By viewing both maps sides by sides, there is a clear negative correlation where states with low scores of 1 and 2 have higher death rates compared to states with high scores of 4 and 5.