Prompt

The CDC publishes firearm mortality for each State per 100,000 persons (https://www.cdc.gov/nchs/state-stats/deaths/firearms.html). 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?” For this assignment you will need to: Access the firearm mortality data from the CDC using an available API (https://open.cdc.gov/apis.html) Create a 5 point Likert scale categorizing gun control laws from most lax to strictest and assign each state to the most appropriate Likert bin. Determine whether stricter gun control laws result in reduced gun violence deaths Present your story using heat maps

R Packages

library(tidyverse)
library(httr)
library(jsonlite)
library(dplyr)
library(ggplot2)
library(reshape2)
library(usmap)

Data Import

url <- "https://data.cdc.gov/api/v3/views/fpsi-y8tj/query.json"
key <- "MCuyIrLZPnjyG1E7PNCJgbJXZ"
url1 <- "https://raw.githubusercontent.com/Stevee-G/Data608/refs/heads/main/Assignment3/firearm_laws.csv"
url2 <- "https://raw.githubusercontent.com/Stevee-G/Data608/refs/heads/main/Assignment3/law_rankings.csv"

response <- GET(
  url = url,
  add_headers(`X-App-Token` = key)
)
status_code(response)
## [1] 200
stats <- fromJSON(content(response, "text"))

laws <- read_csv(url1)

ranks <- read_csv(url2)

glimpse(stats)
## Rows: 2,142
## Columns: 12
## $ `:id`          <chr> "row-44eu_ce5z.4aia", "row-akdk~vxy6-fnjv", "row-4z7i~r…
## $ `:version`     <chr> "rv-zawr_itt7-r8ui", "rv-hcsy_n9ua.tqz6", "rv-papa.wquw…
## $ `:created_at`  <chr> "2026-01-21T18:34:16.529Z", "2026-01-21T18:34:16.529Z",…
## $ `:updated_at`  <chr> "2026-05-14T16:35:09.836Z", "2026-05-14T16:35:09.836Z",…
## $ geoid          <chr> "01", "01", "01", "01", "01", "01", "01", "01", "01", "…
## $ name           <chr> "Alabama", "Alabama", "Alabama", "Alabama", "Alabama", …
## $ intent         <chr> "FA_Deaths", "FA_Deaths", "FA_Homicide", "FA_Homicide",…
## $ period         <chr> "2024", "TTM", "2019", "2020", "2021", "2022", "2023", …
## $ count_sup      <chr> "1212", "1126", "486", "564", "650", "624", "633", "562…
## $ rate           <chr> "23.70000000000000", "22.00000000000000", "9.9000000000…
## $ data_as_of     <chr> "2026-05-14T00:00:00.000", "2026-05-14T00:00:00.000", "…
## $ ttm_date_range <chr> NA, "January, 2025 to December, 2025", NA, NA, NA, NA, …
glimpse(laws)
## Rows: 1,902
## Columns: 13
## $ state                                  <chr> "Alaska", "Alaska", "Alaska", "…
## $ state_abb                              <chr> "AK", "AK", "AK", "AK", "AK", "…
## $ fips                                   <chr> "02", "02", "02", "02", "02", "…
## $ year                                   <dbl> 2024, 2024, 2024, 2024, 2024, 2…
## $ year_frac                              <dbl> 0, 0, 1, 0, 0, 1, 1, 1, 1, 1, 0…
## $ law_class                              <chr> "carrying a concealed weapon (c…
## $ law_class_subtype                      <chr> "prohibited", "shall issue", "s…
## $ handguns_or_long_guns                  <chr> "handgun", "handgun", "handgun"…
## $ age_for_minimum_age_laws               <dbl> NA, NA, NA, NA, NA, 16, 18, 16,…
## $ length_of_waiting_period_days_handguns <dbl> NA, NA, NA, NA, NA, NA, NA, NA,…
## $ additional_context_and_notes           <chr> "Prior law prohibiting conceale…
## $ discrepancies                          <chr> NA, NA, NA, NA, NA, NA, NA, NA,…
## $ law_id                                 <chr> "AK1002", "AK1003", "AK1004", "…
glimpse(ranks)
## Rows: 123
## Columns: 6
## $ category              <chr> "use, storage, and carrying", "use, storage, and…
## $ label                 <chr> "castle doctrine laws", "castle doctrine laws", …
## $ law_class             <chr> "castle doctrine", "castle doctrine", "castle do…
## $ law_class_subtype     <chr> "stand your ground", "expanded 1", "expanded 2",…
## $ handguns_or_long_guns <chr> "handgun and long gun", "handgun and long gun", …
## $ points                <dbl> 1, 2, 3, 4, 1, 1, 2, 3, 1, 2, 3, 4, 1, 1, 1, 1, …

Data Wrangling

stats_trim <- stats %>% 
  filter(period == "2024" & intent == "FA_Deaths") %>% 
  mutate(count_sup = as.integer(count_sup),
         rate = as.double(rate),
         percentile = percent_rank(rate),
         d_bin = cut(percentile,
                   breaks = c(0, 0.2, 0.4, 0.6, 0.8, 1),
                   labels = c("Lowest Mortality", "Low Mortality",
                              "Somewhere In Between",
                              "High Mortality", "Highest Mortality"),
                   include.lowest = TRUE),
         d_level = case_when(
           d_bin == "Lowest Mortality" ~ 1,
           d_bin == "Low Mortality" ~ 2,
           d_bin == "Somewhere In Between" ~ 3,
           d_bin == "High Mortality" ~ 4,
           d_bin == "Highest Mortality" ~ 5)) %>% 
  select(name, intent, count_sup, rate, d_bin, d_level)
glimpse(stats_trim)
## Rows: 51
## Columns: 6
## $ name      <chr> "Alabama", "Alaska", "Arizona", "Arkansas", "California", "C…
## $ intent    <chr> "FA_Deaths", "FA_Deaths", "FA_Deaths", "FA_Deaths", "FA_Deat…
## $ count_sup <int> 1212, 182, 1331, 638, 2853, 961, 224, 123, 148, 3191, 1985, …
## $ rate      <dbl> 23.7, 24.8, 17.9, 20.8, 7.3, 16.4, 6.2, 11.9, 21.8, 14.1, 18…
## $ d_bin     <fct> Highest Mortality, Highest Mortality, High Mortality, Highes…
## $ d_level   <dbl> 5, 5, 4, 5, 1, 3, 1, 2, 5, 3, 4, 1, 3, 2, 4, 2, 3, 4, 5, 2, …
laws_trim <- laws %>% 
  arrange(desc(law_id)) %>% 
  mutate(bridge = paste(law_class,
                        law_class_subtype,
                        handguns_or_long_guns)) %>%
  distinct(paste(state, bridge), .keep_all = TRUE) %>% 
  arrange(law_id) %>% 
  select(state, bridge)
glimpse(laws_trim)
## Rows: 1,629
## Columns: 2
## $ state  <chr> "Alaska", "Alaska", "Alaska", "Alaska", "Alaska", "Alaska", "Al…
## $ bridge <chr> "carrying a concealed weapon (ccw) prohibited handgun", "carryi…
ranks$bridge <- paste(ranks$law_class,
                      ranks$law_class_subtype,
                      ranks$handguns_or_long_guns)
glimpse(ranks)
## Rows: 123
## Columns: 7
## $ category              <chr> "use, storage, and carrying", "use, storage, and…
## $ label                 <chr> "castle doctrine laws", "castle doctrine laws", …
## $ law_class             <chr> "castle doctrine", "castle doctrine", "castle do…
## $ law_class_subtype     <chr> "stand your ground", "expanded 1", "expanded 2",…
## $ handguns_or_long_guns <chr> "handgun and long gun", "handgun and long gun", …
## $ points                <dbl> 1, 2, 3, 4, 1, 1, 2, 3, 1, 2, 3, 4, 1, 1, 1, 1, …
## $ bridge                <chr> "castle doctrine stand your ground handgun and l…
state_laws <- full_join(laws_trim, ranks,
                        join_by(bridge == bridge),
                        relationship = "many-to-one") %>% 
  select(state, category, label, points) %>% 
  group_by(state, category, label) %>% 
  summarize(
    points = sum(points)
  ) %>% 
  drop_na()
glimpse(state_laws)
## Rows: 748
## Columns: 4
## Groups: state, category [153]
## $ state    <chr> "Alabama", "Alabama", "Alabama", "Alabama", "Alabama", "Alaba…
## $ category <chr> "ownership, purchase, and possession", "ownership, purchase, …
## $ label    <chr> "domestic violence restraining orders", "expanded mental heal…
## $ points   <dbl> 1, 3, 3, 4, 5, 1, 1, 2, 2, 5, 3, 3, 2, 1, 5, 6, 1, 2, 1, 8, 7…
state_rank <- state_laws %>% 
  group_by(state) %>% 
  summarize(
    total = sum(points)
  ) %>% 
  mutate(percentile = percent_rank(total),
         s_bin = cut(percentile,
                   breaks = c(0, 0.2, 0.4, 0.6, 0.8, 1),
                   labels = c("Most Lax", "Somewhat Lax",
                              "Somewhere In Between",
                              "Somewhat Strict", "Most Strict"),
                   include.lowest = TRUE),
         s_level = case_when(
           s_bin == "Most Lax" ~ 1,
           s_bin == "Somewhat Lax" ~ 2,
           s_bin == "Somewhere In Between" ~ 3,
           s_bin == "Somewhat Strict" ~ 4,
           s_bin == "Most Strict" ~ 5))
glimpse(state_rank)
## Rows: 51
## Columns: 5
## $ state      <chr> "Alabama", "Alaska", "Arizona", "Arkansas", "California", "…
## $ total      <dbl> 33, 35, 47, 36, 116, 67, 93, 59, 93, 63, 45, 88, 33, 105, 4…
## $ percentile <dbl> 0.12, 0.16, 0.46, 0.18, 1.00, 0.80, 0.92, 0.68, 0.92, 0.78,…
## $ s_bin      <fct> Most Lax, Most Lax, Somewhere In Between, Most Lax, Most St…
## $ s_level    <dbl> 1, 1, 3, 1, 5, 4, 5, 4, 5, 4, 2, 5, 1, 5, 2, 3, 1, 1, 2, 2,…
all <- full_join(state_laws,
                 full_join(stats_trim, state_rank,
                           join_by(name == state),
                           relationship = "many-to-one"),
                 join_by(state == name),
                 relationship = "many-to-many") %>% 
  select(-percentile)
glimpse(all)
## Rows: 748
## Columns: 12
## Groups: state, category [153]
## $ state     <chr> "Alabama", "Alabama", "Alabama", "Alabama", "Alabama", "Alab…
## $ category  <chr> "ownership, purchase, and possession", "ownership, purchase,…
## $ label     <chr> "domestic violence restraining orders", "expanded mental hea…
## $ points    <dbl> 1, 3, 3, 4, 5, 1, 1, 2, 2, 5, 3, 3, 2, 1, 5, 6, 1, 2, 1, 8, …
## $ intent    <chr> "FA_Deaths", "FA_Deaths", "FA_Deaths", "FA_Deaths", "FA_Deat…
## $ count_sup <int> 1212, 1212, 1212, 1212, 1212, 1212, 1212, 1212, 1212, 1212, …
## $ rate      <dbl> 23.7, 23.7, 23.7, 23.7, 23.7, 23.7, 23.7, 23.7, 23.7, 23.7, …
## $ d_bin     <fct> Highest Mortality, Highest Mortality, Highest Mortality, Hig…
## $ d_level   <dbl> 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, …
## $ total     <dbl> 33, 33, 33, 33, 33, 33, 33, 33, 33, 33, 33, 33, 35, 35, 35, …
## $ s_bin     <fct> Most Lax, Most Lax, Most Lax, Most Lax, Most Lax, Most Lax, …
## $ s_level   <dbl> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, …

Data Visualizations

plot_usmap(data = all, values = "d_level", color = "black") +
  scale_fill_continuous(low = "whitesmoke",
                        high = "red",
                        name = "Mortality Rate",
                        label = scales::comma) +
  labs(title = "Heatmap: USA Firearm Mortality") +
  theme(legend.position = "right") +
  theme(plot.title = element_text(hjust = 0.5))

plot_usmap(data = all, values = "s_level", color = "black") +
  scale_fill_continuous(low = "whitesmoke",
                        high = "blue",
                        name = "Law Strictness",
                        label = scales::comma) +
  labs(title = "Heatmap: USA Firearm Laws") +
  theme(legend.position = "left") +
  theme(plot.title = element_text(hjust = 0.5))

count_data <- all %>%
  ungroup() %>%  
  count(d_bin, s_bin, name = "count")

ggplot(count_data, aes(x = s_bin, y = d_bin)) +
  geom_tile(aes(fill = count), color = "white", linewidth = 0.5) +
  scale_fill_gradient(low = "whitesmoke", high = "darkviolet") +
  labs(title = "Heatmap: Law Strictness vs Mortality",
       x = "",
       y = "",
       fill = "Count") +
  theme_minimal() +
  theme(plot.title = element_text(hjust = 0.5),
        axis.text.x = element_text(angle = 45, hjust = 1))

ggplot(all, aes(x=total, y=rate)) +
  geom_point() +
  labs(title = "Scatterplot: Firearm Laws vs Mortality Rate",
       x = "Relative Law Value",
       y = "Relative Mortality Rate") +
  geom_smooth(color = "darkviolet") +
  theme_minimal() +
  theme(plot.title = element_text(hjust = 0.5))

Sources

CDC FA Mortality: (https://data.cdc.gov/Injury-Violence/Mapping-Injury-Overdose-and-Violence-State/fpsi-y8tj/about_data)

Rand FA Laws: (https://www.rand.org/research/gun-policy/law-navigator.html#minimum-age-for-possession)