Story 3- Gun Laws Strength Category by Firearm Mortality Rates for each U.S State

Introduction

I sourced the Mortality Rate data from CDC.gov through an API endpoint, gun laws rank and grade data from Giffords.org for each State through csv file, formatted and prepared the data for visualization.

Data Preparation and Transformation

library (tidyr)

library(dplyr)

#to make HTTP requests like GET 
library(httr)

#jsonlite is JSON parser/generator optimized for the web ..used for fromJSON()
library(jsonlite)

# to use str_to_title function 
library(stringr)

# to use the read_csv function to load gunlaws by state
library(readr)

# to create heatmap
library(ggplot2)
library(reshape2)

# to use several colorblind-accessible palettes
library(RColorBrewer)
library(viridis)

# API endpoint provided by the CDC website when selected the data from the site link
# NCHS - VSRR Quarterly provisional estimates for selected indicators of mortality
# https://data.cdc.gov/NCHS/NCHS-VSRR-Quarterly-provisional-estimates-for-sele/489q-934x/about_data
# Make the POST request
  response <- GET("https://data.cdc.gov/resource/489q-934x.json")
  
# Check if the request was successful
  if (status_code(response) == 200) {
    # Parse the JSON response
    data <- fromJSON(content(response, "text",encoding = "UTF-8"))
  }
#Filter the data to the fire arm related deaths only for the year
   filtered_data <- filter(data,
          cause_of_death == "Firearm-related injury" &
          time_period == "12 months ending with quarter" &
          rate_type == "Age-adjusted"&
          grepl("Q4", year_and_quarter) &
          grepl("2023", year_and_quarter)  )
   
# select only the required variables
   selected_data <- filtered_data %>%
  select(!c(time_period,cause_of_death,rate_type,unit,rate_overall,rate_sex_female,rate_sex_male) )
  
#Pivot from columns to rows to move the State field to rows
   pivoted_data<-selected_data |>
     pivot_longer(
    cols = starts_with("rate_"), 
    names_to = "State", 
    values_to = "mortality_rate",
   values_drop_na = TRUE
  )

# Cleanse  and transform the data 
   firearm_mortality <- pivoted_data  |>
     separate_wider_delim(State, delim = "rate_", names = c("text", "State"),too_many ="drop") |>
     separate_wider_delim(year_and_quarter, delim = " ", names = c("Year", "Quarter"),too_many ="drop") |>
     select(!c(text,Quarter)) |>
     mutate(State = str_to_title(gsub("_", " ", State)))
     
# Fetch the gunlaws by each US State from giffords.org
# https://giffords.org/lawcenter/resources/scorecard2023/ 
# i downloaded the data into csv and uploaded to my Github
   
  gun_laws_raw <- read_csv("https://raw.githubusercontent.com/datanerddhanya/DATA608/refs/heads/main/strictest-gun-laws-by-state-2024.csv", col_names = TRUE, show_col_types = FALSE)

gun_laws_strength <- gun_laws_raw |>
    mutate ( FireArmLawCategory = case_when(
    GunLawsStrengthRank >= 1 & GunLawsStrengthRank <= 10 ~ "Very Strict",
    GunLawsStrengthRank >= 11 & GunLawsStrengthRank <= 20 ~ "Strict",
    GunLawsStrengthRank >= 21 & GunLawsStrengthRank <= 30 ~ "Moderate",
    GunLawsStrengthRank >= 31 & GunLawsStrengthRank <= 40 ~ "Lax",
    GunLawsStrengthRank >= 41 & GunLawsStrengthRank <= 50 ~ "Very Lax")) |>
    select(State,GunLawsStrengthRank,GunLawsGiffordGrade,FireArmLawCategory )
  

#merge both the datasets to create a combined table
merged_data <- merge(firearm_mortality, gun_laws_strength, by = "State")

# Ensure mortality_rate is numeric
merged_data$mortality_rate <- as.numeric(as.character(merged_data$mortality_rate))

# Convert FireArmLawCategory to a factor with the desired order
merged_data$FireArmLawCategory <- factor(merged_data$FireArmLawCategory, 
                                         levels = c("Very Lax", "Lax", "Moderate", "Strict", "Very Strict"))

#Heat Map 1 

print(ggplot(merged_data, aes(x = FireArmLawCategory, y = reorder(State, mortality_rate))) +
  geom_tile(aes(fill = mortality_rate), color = "white") +
 scale_fill_viridis(name = "Mortality Rate", labels = c("0", "10", "20", "29.8"),) +
  labs(title = "Gun Laws Strength Category by  Firearm Mortality Rates for each U.S State, 2023",
       x = "Gun Laws Strength Category",
       y = "U.S State") +
  theme_minimal() +
  theme(axis.text.x = element_text(hjust = 1),
        axis.text.y = element_text(size = 10,margin = margin(t = 0, r = 10, b = 0, l = 0)),
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank()
        ))

# Save the plot with adjusted dimensions
#ggsave("gun_control_heatmap.png", plot = z, width = 12, height = 15, dpi = 300)



# Map gun_control_laws to a 5-point Likert scale
merged_data$Likert_gun_control <- recode(merged_data$FireArmLawCategory,
                                "Very Strict" = 1,
                                 "Strict" = 2,
                                "Moderate" = 3,
                                "Lax" = 4,
                                "Very Lax" = 5)
# Discretizing mortality_rate into bins
merged_data$mortality_rate_bins <- cut(merged_data$mortality_rate, 
                                       breaks = 5, 
                                       labels = c("Very Low", "Low", "Moderate", "High", "Very High"))

#Visual Chart 2

print(ggplot(merged_data, aes(x = FireArmLawCategory , y = mortality_rate_bins)) +
  geom_tile(aes(fill = Likert_gun_control), color = "white") +
  scale_fill_viridis( name = "Gun Laws Strength Category",labels = c("Very Strict","Strict","Moderate", "Lax","Very Lax"),
    limits = c(1, 5), option="D") +
  labs(title = "Gun Laws Strength Category by  Firearm Mortality Rates for each U.S State (5-Point Likert Scale)",
       x = "Gun Laws Strength Category (Likert Scale)",
       y = "Mortality Rate") +
  theme_minimal() +
  theme(axis.text.x = element_text(hjust = 1),
        axis.text.y = element_text(size = 10,margin = margin(t = 0, r = 0, b = 10, l = 0)),
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        )
)

#Save the plot with adjusted dimensions
#ggsave("gun_control_heatmap2.png", plot = q, width = 12, height = 15, dpi = 300)


#Visual Chart 3
# Select only numeric columns
merged_data_numeric <- merged_data %>% select_if(is.numeric) %>% select( mortality_rate, Likert_gun_control)

# Calculate the correlation matrix
cor_matrix <- cor(merged_data_numeric, use = "pairwise.complete.obs")

# Melt the correlation matrix for ggplot
cor_melted <- melt(cor_matrix)

# Create the heatmap
ggplot(cor_melted, aes(x = Var1  , y = Var2 , fill = value)) +
  geom_tile() +
  scale_fill_viridis_c(name = "Pearson\nCorrelation", limits = c(-1, 1), 
                        option = "D") +
  theme_minimal() + 
  theme(axis.text.x = element_text(vjust = 1, hjust = 1)) +
  coord_fixed() +
  geom_text(aes(label = round(value, 2)), color = "black", size = 4) +
  labs(title = "Correlation Heatmap  of Gun Laws Strength Category vs.  Firearm Mortality Rates",
       x = "",
       y = "") 

# Save the plot
#ggsave("correlation_heatmap.png", plot = q, width = 10, height = 8, dpi = 300)

Summary:

In the first Heatmap, I sorted the states by Mortality Rates and it is observed that states with the “very lax” gun laws experience the highest firearm-related death rates, while states with the “very strict” gun laws have the lowest death rates. I see a outlier in New Mexico , which may be due to other contributing factors. In the last heatmap, I plotted the correlation and I see a value of 0.69 between the two which is a positive correlation. In conclusion, it can be said that stricter firearm control laws contribute to a reduction in firearm mortality rates in U.S. states in 2023.