Hide Assignment Information Instructions The CDC publishes firearm mortality for each State per 100,000 persons https://www.cdc.gov/nchs/pressroom/sosmap/firearm_mortality/firearm.htm. 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

Libraries needed:

library(httr)
library(tidyverse)
library(jsonlite)
library(plotly)

Pull CDC mortality data and load it into a usable DF

mort_url <- "https://data.cdc.gov/resource/489q-934x.json"
res <- GET(mort_url)
mort_list <- fromJSON(content(res, "text", encoding = "UTF-8"))
mort_data <- as.data.frame(mort_list)

Clean and subset data for firearm related deaths

mort_data_1 <- mort_data %>% 
    select(1:4,rate_alaska:rate_wyoming) %>% 
    filter(cause_of_death == "Firearm-related injury" & year_and_quarter == "2023 Q4" & time_period == "12 months ending with quarter" & rate_type == "Crude")
    
mort_data_long <- mort_data_1 %>%
    select(1,rate_alaska:rate_wyoming) %>% 
    pivot_longer(cols = everything(), names_to = "States", values_to = "Mortality Rates (By State)") %>% 
    slice(-1) %>% 
    mutate(`Mortality Rates (By State)` = as.numeric(`Mortality Rates (By State)`))

Rename states to correct abbreviations (generated using an AI prompt)

state_abbreviations <- c(
  rate_alaska = "AK",
  rate_alabama = "AL",
  rate_arkansas = "AR",
  rate_arizona = "AZ",
  rate_california = "CA",
  rate_colorado = "CO",
  rate_connecticut = "CT",
  rate_district_of_columbia = "DC",
  rate_delaware = "DE",
  rate_florida = "FL",
  rate_georgia = "GA",
  rate_hawaii = "HI",
  rate_idaho = "ID",
  rate_illinois = "IL",
  rate_indiana = "IN",
  rate_iowa = "IA",
  rate_kansas = "KS",
  rate_kentucky = "KY",
  rate_louisiana = "LA",
  rate_maine = "ME",
  rate_maryland = "MD",
  rate_massachusetts = "MA",
  rate_michigan = "MI",
  rate_minnesota = "MN",
  rate_mississippi = "MS",
  rate_missouri = "MO",
  rate_montana = "MT",
  rate_nebraska = "NE",
  rate_nevada = "NV",
  rate_new_hampshire = "NH",
  rate_new_jersey = "NJ",
  rate_new_mexico = "NM",
  rate_new_york = "NY",
  rate_north_carolina = "NC",
  rate_north_dakota = "ND",
  rate_ohio = "OH",
  rate_oklahoma = "OK",
  rate_oregon = "OR",
  rate_pennsylvania = "PA",
  rate_rhode_island = "RI",
  rate_south_carolina = "SC",
  rate_south_dakota = "SD",
  rate_tennessee = "TN",
  rate_texas = "TX",
  rate_utah = "UT",
  rate_vermont = "VT",
  rate_virginia = "VA",
  rate_washington = "WA",
  rate_west_virginia = "WV",
  rate_wisconsin = "WI",
  rate_wyoming = "WY"
)

state_abbreviations_df <- data.frame(
  States = names(state_abbreviations),
  Abbreviation = state_abbreviations,
  stringsAsFactors = FALSE
)

rename_mort <- mort_data_long %>%
  left_join(state_abbreviations_df, by = "States") %>%
  mutate(States = Abbreviation) %>%
  select(-Abbreviation) %>% 
  filter(States != "DC")

Gun law strictness:

I will be using world population reviews gun law strength ranking to separate into categories: https://worldpopulationreview.com/state-rankings/strictest-gun-laws-by-state

gun_law <- read.csv("https://raw.githubusercontent.com/jonburns2454/data-608/refs/heads/main/strictest-gun-laws-by-state-2024.csv")

state_abbreviations_2 <- c(
  "Alabama" = "AL",
  "Alaska" = "AK",
  "Arizona" = "AZ",
  "Arkansas" = "AR",
  "California" = "CA",
  "Colorado" = "CO",
  "Connecticut" = "CT",
  "Delaware" = "DE",
  "Florida" = "FL",
  "Georgia" = "GA",
  "Hawaii" = "HI",
  "Idaho" = "ID",
  "Illinois" = "IL",
  "Indiana" = "IN",
  "Iowa" = "IA",
  "Kansas" = "KS",
  "Kentucky" = "KY",
  "Louisiana" = "LA",
  "Maine" = "ME",
  "Maryland" = "MD",
  "Massachusetts" = "MA",
  "Michigan" = "MI",
  "Minnesota" = "MN",
  "Mississippi" = "MS",
  "Missouri" = "MO",
  "Montana" = "MT",
  "Nebraska" = "NE",
  "Nevada" = "NV",
  "New Hampshire" = "NH",
  "New Jersey" = "NJ",
  "New Mexico" = "NM",
  "New York" = "NY",
  "North Carolina" = "NC",
  "North Dakota" = "ND",
  "Ohio" = "OH",
  "Oklahoma" = "OK",
  "Oregon" = "OR",
  "Pennsylvania" = "PA",
  "Rhode Island" = "RI",
  "South Carolina" = "SC",
  "South Dakota" = "SD",
  "Tennessee" = "TN",
  "Texas" = "TX",
  "Utah" = "UT",
  "Vermont" = "VT",
  "Virginia" = "VA",
  "Washington" = "WA",
  "West Virginia" = "WV",
  "Wisconsin" = "WI",
  "Wyoming" = "WY"
)

gun_law_rc <- gun_law %>%
  mutate(States = recode(state, !!!state_abbreviations_2)) %>% 
  select(state, GunLawsStrengthRank, States)

full_df <- rename_mort %>% 
  left_join(gun_law_rc,by = "States")

full_categories <- full_df %>%
  mutate(Gun_Law_Rank = case_when(
    GunLawsStrengthRank >= 1 & GunLawsStrengthRank <= 10 ~ 1,
    GunLawsStrengthRank >= 11 & GunLawsStrengthRank <= 20 ~ 2,
    GunLawsStrengthRank >= 21 & GunLawsStrengthRank <= 30 ~ 3,
    GunLawsStrengthRank >= 31 & GunLawsStrengthRank <= 40 ~ 4,
    GunLawsStrengthRank >= 41 & GunLawsStrengthRank <= 50 ~ 5,
  ))

library(maps)
library(patchwork)

us_map <- map_data("state")

frmt_states <- full_categories %>%
  mutate(region = tolower(state))

map_data <- us_map %>%
  left_join(frmt_states, by = "region")

centroids <- map_data %>%
  group_by(region) %>%
  summarize(long = mean(long), lat = mean(lat), States = first(States))

library(gridExtra)

## 
## Attaching package: 'gridExtra'

## The following object is masked from 'package:dplyr':
## 
##     combine

gun_mortality_heatmap<-ggplot(map_data, aes(x = long, y = lat, group = group, fill = `Mortality Rates (By State)`)) +
  geom_polygon(color = "white") +
  coord_fixed(1.3) +
  scale_fill_gradient(low = "white", high = "purple", name = "Mortality Rates from Firearms") +
  labs(title = "Gun Deaths by State",
       caption = "Source: CDC Mortality Rates Database",
       subtitle = "Lowest to Highest Firearm Related Mortalities") +
  theme_minimal() +
  theme(legend.position = "bottom",
        axis.title.x = element_blank(),
        axis.title.y = element_blank(),
        axis.text.x = element_blank(),
        axis.text.y = element_blank(),
        axis.ticks.x = element_blank(),
        axis.ticks.y = element_blank(),
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank())

Gun_Law_Heatmap <- ggplot(map_data, aes(x = long, y = lat, group = group, fill = Gun_Law_Rank)) +
  geom_polygon(color = "white") +
  coord_fixed(1.3) +
  scale_fill_gradient(low = "lightgrey", high = "coral2", name = "Gun Law Ranking") +
  labs(title = "Gun Law Strictness by State",
       caption = "Source: World Population Report",
       subtitle = "Most to Least Strict (1-5)") +
  theme_minimal() +
  theme(
    legend.position = "bottom",
    axis.title.x = element_blank(),
    axis.title.y = element_blank(),
    axis.text.x = element_blank(),
    axis.text.y = element_blank(),
    axis.ticks.x = element_blank(),
    axis.ticks.y = element_blank(),
    panel.grid.major = element_blank(),
    panel.grid.minor = element_blank()
  )
combined_plot <- grid.arrange(Gun_Law_Heatmap,gun_mortality_heatmap, ncol = 2)

print(combined_plot)

## TableGrob (1 x 2) "arrange": 2 grobs
##   z     cells    name           grob
## 1 1 (1-1,1-1) arrange gtable[layout]
## 2 2 (1-1,2-2) arrange gtable[layout]

Story 3 - JBurns

Jonathan Burns

2024-10-06

Libraries needed:

Pull CDC mortality data and load it into a usable DF

Rename states to correct abbreviations (generated using an AI prompt)

Gun law strictness: