Story -3 : Do stricter gun laws reduce firearm gun deaths?

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

# load libraries 

library(dplyr)
## 
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
library(ggplot2)
library(readr)
library(httr)
library(jsonlite)
library(tidyverse)
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ forcats   1.0.0     ✔ stringr   1.5.1
## ✔ lubridate 1.9.3     ✔ tibble    3.2.1
## ✔ purrr     1.0.2     ✔ tidyr     1.3.1
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter()  masks stats::filter()
## ✖ purrr::flatten() masks jsonlite::flatten()
## ✖ dplyr::lag()     masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(plotly)
## 
## Attaching package: 'plotly'
## 
## The following object is masked from 'package:httr':
## 
##     config
## 
## The following object is masked from 'package:ggplot2':
## 
##     last_plot
## 
## The following object is masked from 'package:stats':
## 
##     filter
## 
## The following object is masked from 'package:graphics':
## 
##     layout
# Step 1 
# read the data from the jason file 
url <- "https://data.cdc.gov/resource/489q-934x.json"
res <- GET(url)
content <- fromJSON(content(res, "text", encoding = "UTF-8"))
data <- as.data.frame(content)


# Step 2 
# read the gun Law data set 
gun_law_data <- read.csv("strictest-gun-laws-by-state-2024.csv")


# Step 3 population
population <- read.csv("population.csv")

We will transform the dataset by incorporating additional geographic information, including state abbreviations, as well as the corresponding latitude and longitude coordinates. This transformation will allow us to enhance the dataset with precise location data, enabling the creation of more detailed visualizations and analyses, such as mapping the data to specific U.S. states and their respective positions on a geographic plot.

This is a map titled “Gun Law Strictness and Firearm Death Rates.” It shows how strict gun laws are and how those relate to firearm death rates across different states.

States with stricter gun laws (shown in cooler colors) tend to have lower firearm death rates, while those with more lenient laws (shown in warmer colors) tend to have higher death rates.

### Preparing Mortality Data 
# Step 1: Remove 'rate_district_of_columbia' column and filter out '2024 Q1' rows
mortality_rate <- data %>%
  select(1:4, -rate_district_of_columbia, rate_alaska:rate_wyoming) %>%  # Select all except the 'rate_district_of_columbia' column
  filter(cause_of_death == "Firearm-related injury" &
           time_period == "12 months ending with quarter" &
           rate_type == "Crude" &
           year_and_quarter != "2024 Q1")  # Filter out the '2024 Q1' rows

# Step 2: Convert all rate columns (state columns) to numeric
mortality_rate <- mortality_rate %>%
  mutate(across(starts_with("rate_"), as.numeric))
## Warning: There was 1 warning in `mutate()`.
## ℹ In argument: `across(starts_with("rate_"), as.numeric)`.
## Caused by warning:
## ! NAs introduced by coercion
# Calulate mortality mean 
mean_mortality <- mortality_rate %>% select(-rate_type) %>%
  summarise(across(starts_with("rate_"), mean, na.rm = TRUE)) 
## Warning: There was 1 warning in `summarise()`.
## ℹ In argument: `across(starts_with("rate_"), mean, na.rm = TRUE)`.
## Caused by warning:
## ! The `...` argument of `across()` is deprecated as of dplyr 1.1.0.
## Supply arguments directly to `.fns` through an anonymous function instead.
## 
##   # Previously
##   across(a:b, mean, na.rm = TRUE)
## 
##   # Now
##   across(a:b, \(x) mean(x, na.rm = TRUE))
mean_mortality <- mean_mortality %>%
  rename_with(~ str_replace(., "rate_", ""), starts_with("rate_"))  # Remove 'rate_' prefix

### Changing the format to long 

# Step 5: Pivot the data to longer format, remove the 'rate_' prefix from state names, and rename the column
mortality_long <- mortality_rate %>%
  select(1, rate_alaska:rate_wyoming) %>%  # Select year_and_quarter and all rate columns for states
  pivot_longer(cols = rate_alaska:rate_wyoming, 
               names_to = "states", 
               values_to = "mortality_rate") %>%  # Rename the value column to 'mortality_rate'
  mutate(states = str_replace_all(states, "rate_", ""),  # Remove 'rate_' prefix from state names
         states = str_replace_all(states, "_", " "))     # Replace underscores with spaces


mean_mortality_long <- mean_mortality %>%
  pivot_longer(cols = everything(), 
               names_to = "states", 
               values_to = "mortality_rate") %>%  # Rename the value column to 'mortality_rate'
  mutate(states = str_replace_all(states, "_", " "))     # Replace underscores with spaces

# Step 7: Print the head of the long data to check
head(mean_mortality_long)
## # A tibble: 6 × 2
##   states     mortality_rate
##   <chr>               <dbl>
## 1 alaska              23.3 
## 2 alabama             25.5 
## 3 arkansas            22.2 
## 4 arizona             20.0 
## 5 california           8.76
## 6 colorado            17.6
#############################################################

# Preparing gun law data set 

# 1. First, mutate gun_law_data to include state abbreviations
gun_law_data <- gun_law_data %>%
  mutate(States = state.abb[match(state, state.name)])

# 2. Ensure that the states column in both data frames is properly formatted
mean_Mort_long_data <- mean_mortality_long %>%
  mutate(states = tolower(states))  

# 3. Ensure that the states column in both data frames is properly formatted
gun_law_data <- gun_law_data %>%
  mutate(state = tolower(state))

# 4. Now proceed with the merge (join) by the state abbreviation
merged_data <- merge(mean_Mort_long_data, gun_law_data, by.x = "states", by.y = "state")

# Merge map data with the population for dots
population <- population %>%
  mutate(state_name = tolower(state)) %>%
  select(-state)

data_final <- merged_data %>%
  left_join(population, by = c("states" = "lower_sate"))


# Convert gun_laws_strength_rank column to numeric
data_final <- data_final %>%
  mutate(GunControlCategory = case_when(
    GunLawsGiffordGrade %in% c("A", "A-") ~ "Most Strict",
    GunLawsGiffordGrade %in% c("B+", "B") ~ "Strict",
    GunLawsGiffordGrade %in% c("B-", "C+") ~ "Moderate",
    GunLawsGiffordGrade %in% c("C", "C-", "D+") ~ "Lax",
    GunLawsGiffordGrade == "F" ~ "Most Lax",
    TRUE ~ NA_character_  # Handles any unexpected values
  ))
# Prepare map data
states_map <- map_data("state")

# Calculate centroids of states for plotting points
state_centroids <- states_map %>%
  group_by(region) %>%
  summarize(long = mean(range(long)), lat = mean(range(lat)))

# Merge centroids with the merged data
data_final_centroids <- state_centroids %>%
  left_join(data_final, by = c("region" = "states"))

# Standardize GunLawsStrengthRank using min-max normalization

data_final <- data_final %>%
  mutate(GunLawsStrengthRank_std = (GunLawsStrengthRank - min(GunLawsStrengthRank, na.rm = TRUE)) /
           (max(GunLawsStrengthRank, na.rm = TRUE) - min(GunLawsStrengthRank, na.rm = TRUE)))

# Standardize mortality_rate using min-max normalization
data_final <- data_final %>%
  mutate(mortality_rate_std = (mortality_rate - min(mortality_rate, na.rm = TRUE)) /
           (max(mortality_rate, na.rm = TRUE) - min(mortality_rate, na.rm = TRUE)))
usa_map <- map_data('state')
state_abbreviations <- data.frame(
  state_annotaion = tolower(state.name),  # State names in lowercase to match map_data("state")
  STATE = state.abb  # State abbreviations
)

# Create the usa data set abbreviation 
usa_map <- merge(usa_map, state_abbreviations, by.x = "region", by.y = "state_annotaion")





usa_map <- usa_map %>% left_join(population, by= c("region"="lower_sate"))
#usa_map <- usa_map %>% mutate(states = tolower(state))
##usa_map <- merge(usa_map, population, by.x = "region", by.y = "lower_sate")
#Merge the state map data with your dataset

data_final_map <- data_final %>% left_join(usa_map, by= c("states"="region"))

# Create the base map with gun law strictness
map1 <- ggplot(data_final_map, aes(x = long, y = lat, group = group)) +  geom_polygon(aes(fill = GunLawsGunDeathRateRank), color = "black")

# Add firearm death data as points, adjusting size based on death rate


map2 <- map1 + 
  geom_point(aes(x = long, y = lat, color = GunLawsGunDeathRatePer100k), size = 3, alpha = 0.7) +  # Color-coded points for firearm deaths
  scale_fill_gradient(name = "Mortality per 100k Population", low = "yellow", high = "red", na.value = "grey50") +
  scale_color_gradient(name = "Firearm Death Rate", low = "blue", high = "red") +  # Gradient color for death rate
  theme(axis.text.x = element_blank(),
        axis.text.y = element_blank(),
        axis.ticks = element_blank(),
        axis.title.y = element_blank(),
        axis.title.x = element_blank(),
        rect = element_blank()) + 
  ggtitle("Gun Law Strictness and Firearm Death Rates")

map2

scatterplot <- ggplot(data_final, aes(x = GunLawsStrengthRank, y = GunLawsGunDeathRatePer100k, label = States, color = GunControlCategory)) +
  geom_point() +
  geom_smooth(method = "lm", se = TRUE, color = "red") +  # Add regression line with confidence interval
  geom_text(hjust = 0, nudge_x = 0.1, nudge_y = 0.05) +
  labs(title = "Gun Control laws Strickness by US states",
       x = "Gun Control Laws Strength Rank",
       y = "Fire-Arm Related Death Rate per 100K People",
       color = "Gun Control Strickness") +
  scale_color_manual(values = c("Most Strict" = "red", "Strict" = "purple", "Moderate" = "brown", "Lax" = "green", "Most Lax" = "blue")) +
  theme_minimal()

# Show legend
scatterplot <- scatterplot + theme(legend.position = "right")

# Show scatterplot
scatterplot
## `geom_smooth()` using formula = 'y ~ x'
## Warning: The following aesthetics were dropped during statistical transformation: label.
## ℹ This can happen when ggplot fails to infer the correct grouping structure in
##   the data.
## ℹ Did you forget to specify a `group` aesthetic or to convert a numerical
##   variable into a factor?

This plot visualizes the relationship between gun law strictness and firearm death rates across U.S. states. The states are colored based on their level of gun law strictness, with different colors ranging from green (least strict) to red (most strict).

The scatter plot visualizes the relationship between gun control law strength and firearm death rates across U.S. states. The x-axis represents the strictness of gun laws, with lower values indicating stricter laws. The y-axis shows the death rates from firearms per 100K people. Each state is marked by a point and color-coded according to its gun law strictness. A red trend line, indicating a positive correlation, shows that states with laxer gun laws (higher values on the x-axis) tend to have higher firearm-related death rates. Essentially, this plot highlights that states with stricter gun laws generally experience lower rates of firearm deaths.