Story-3 details:

The purpose of this Story is to answer the question, ” Do stricter firearm control laws help reduce firearm mortality?” To do the visualizations I will need to:

  1. Access the firearm mortality data from the CDC using an available API (https://open.cdc.gov/apis.html)

  2. 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.

  3. Determine wether stricter gun control laws result in reduced gun violence deaths

  4. Present the story using heat maps

It is noted that the CDC publishes firearm mortality for each State per 100,000 persons https://www.cdc.gov/nchs/pressroom/sosmap/firearm_mortality/firearm.htm.

Required Libraries

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

Required link for making API key request: https://socrataapikeys.docs.apiary.io/#introduction/key-id-and-key-secret

# Set JSON data URL
url <- "https://data.cdc.gov/resource/489q-934x.json"

# Fetch JSON data by sending GET request
response_data <- GET(url)

# Parse JSON data to R list
list_data <- fromJSON(content(response_data, "text", encoding = "UTF-8"))

# Convert list to data frame
mortality_data <- as.data.frame(list_data)

# See data details
#str(mortality_data)

# See first 10 rows of data frame
#head(mortality_data,10)

Data Preparation:

Data preparation for getting fire-arm related death rate by US states.

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

# Rename specified columns
mortality_data <- mortality_data %>%
  rename(!!!column_mapping)

# Filter data for fire-arm related injury
firearm_mortality_df <- mortality_data %>%
  filter(cause_of_death == "Firearm-related injury" & 
         rate_type == "Crude" & 
         time_period == "12 months ending with quarter") %>%
  data.frame(row.names = NULL)

# Show updated data frame
#head(firearm_mortality_df,10)

# Subset dataframe by selecting year, state, and rate columns 
final_firearm_mortality_df <- firearm_mortality_df %>%
  mutate(across(6:69, as.double)) %>% #Convert columns 6 to 69 to double
  mutate(year = substr(year_and_quarter, 1, 4)) %>% # Extract year from year_and_quarter
  filter(year == "2021") %>% # Filter for only 2021 data
  pivot_longer(cols = AK:WY, names_to = "state", values_to = "rate") %>% # Pivot the wide format to long format
  select(year, state, rate) 


# Group data by state and calculate average rate for each state
final_firearm_mortality_df <- final_firearm_mortality_df %>%
  group_by(year,state) %>%
  summarize(avg_rate = mean(rate, na.rm = TRUE))
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
head(final_firearm_mortality_df)
## # A tibble: 6 × 3
## # Groups:   year [1]
##   year  state avg_rate
##   <chr> <chr>    <dbl>
## 1 2021  AK       24.4 
## 2 2021  AL       25.1 
## 3 2021  AR       22.8 
## 4 2021  AZ       18.2 
## 5 2021  CA        9.18
## 6 2021  CO       17.2

Data preparation to include gun law strength as per the gun law strength data for year 2021. This data are collected from https://giffords.org/lawcenter/resources/scorecard2021/ . The rank for the DC is not available in the site. The rank for DC is considered by observing the fire-arm related death rate.

# gun law rates
final_firearm_mortality_df <- final_firearm_mortality_df %>%
  mutate(
    gun_laws_strength_rank = case_when(
      state == "AK" ~ "41",
      state == "AL" ~ "31",
      state == "AR" ~ "50",
      state == "AZ" ~ "42",
      state == "CA" ~ "1",
      state == "CO" ~ "13",
      state == "CT" ~ "3",
      state == "DC" ~ "19",
      state == "DE" ~ "12",
      state == "FL" ~ "24",
      state == "GA" ~ "28",
      state == "HI" ~ "4",
      state == "IA" ~ "30",
      state == "ID" ~ "48",
      state == "IL" ~ "8",
      state == "IN" ~ "26",
      state == "KS" ~ "45",
      state == "KY" ~ "42",
      state == "LA" ~ "34",
      state == "MA" ~ "5",
      state == "MD" ~ "7",
      state == "ME" ~ "29",
      state == "MI" ~ "18",
      state == "MN" ~ "17",
      state == "MO" ~ "47",
      state == "MS" ~ "45",
      state == "MT" ~ "40",
      state == "NC" ~ "21",
      state == "ND" ~ "39",
      state == "NE" ~ "20",
      state == "NH" ~ "27",
      state == "NJ" ~ "2",
      state == "NM" ~ "19",
      state == "NV" ~ "16",
      state == "NY" ~ "6",
      state == "OH" ~ "25",
      state == "OK" ~ "37",
      state == "OR" ~ "15",
      state == "PA" ~ "14",
      state == "RI" ~ "9",
      state == "SC" ~ "32",
      state == "SD" ~ "44",
      state == "TN" ~ "37",
      state == "TX" ~ "36",
      state == "UT" ~ "33",
      state == "VA" ~ "11",
      state == "VT" ~ "22",
      state == "WA" ~ "10",
      state == "WI" ~ "22",
      state == "WV" ~ "34",
      state == "WY" ~ "49",
      TRUE ~ NA_character_
    )
  )

head(final_firearm_mortality_df)
## # A tibble: 6 × 4
## # Groups:   year [1]
##   year  state avg_rate gun_laws_strength_rank
##   <chr> <chr>    <dbl> <chr>                 
## 1 2021  AK       24.4  41                    
## 2 2021  AL       25.1  31                    
## 3 2021  AR       22.8  50                    
## 4 2021  AZ       18.2  42                    
## 5 2021  CA        9.18 1                     
## 6 2021  CO       17.2  13
head (final_firearm_mortality_df)
## # A tibble: 6 × 4
## # Groups:   year [1]
##   year  state avg_rate gun_laws_strength_rank
##   <chr> <chr>    <dbl> <chr>                 
## 1 2021  AK       24.4  41                    
## 2 2021  AL       25.1  31                    
## 3 2021  AR       22.8  50                    
## 4 2021  AZ       18.2  42                    
## 5 2021  CA        9.18 1                     
## 6 2021  CO       17.2  13
# Save to a specific folder (replace "path/to/your/folder" with the actual folder path)
#write.csv(final_firearm_mortality_df, "F:\\CUNY masters\\data608\\major assignment_03\\output_file.csv")

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.

# Convert gun_laws_strength_rank column to numeric
final_firearm_mortality_df$gun_laws_strength_rank <- as.numeric(final_firearm_mortality_df$gun_laws_strength_rank)

# Set breaks for Likert scale 
breaks <- c(0, 10, 20, 30, 40, 50)

# Create Likert scale labels
labels <- c("most strict", "strict", "moderate", "lax", "most lax")

# Cut data into Likert scale categories
final_firearm_mortality_df$gun_laws_strength_category <- cut(final_firearm_mortality_df$gun_laws_strength_rank , breaks = breaks, labels = labels, include.lowest = TRUE)

# Display the categorized data
print(final_firearm_mortality_df)
## # A tibble: 51 × 5
## # Groups:   year [1]
##    year  state avg_rate gun_laws_strength_rank gun_laws_strength_category
##    <chr> <chr>    <dbl>                  <dbl> <fct>                     
##  1 2021  AK       24.4                      41 most lax                  
##  2 2021  AL       25.1                      31 lax                       
##  3 2021  AR       22.8                      50 most lax                  
##  4 2021  AZ       18.2                      42 most lax                  
##  5 2021  CA        9.18                      1 most strict               
##  6 2021  CO       17.2                      13 strict                    
##  7 2021  CT        6.88                      3 most strict               
##  8 2021  DC       25.6                      19 strict                    
##  9 2021  DE       15.2                      12 strict                    
## 10 2021  FL       14.3                      24 moderate                  
## # ℹ 41 more rows
# Create a mapping of gun laws strength categories to numeric values
category_mapping <- c(
  "most strict" = 1,
  "strict" = 2,
  "moderate" = 3,
  "lax" = 4,
  "most lax" = 5
)

# Use mapping to create a new column with numeric values
final_firearm_mortality_df$gun_laws_strength_value <- category_mapping[final_firearm_mortality_df$gun_laws_strength_category]
head(final_firearm_mortality_df)
## # A tibble: 6 × 6
## # Groups:   year [1]
##   year  state avg_rate gun_laws_strength_rank gun_laws_strength_category
##   <chr> <chr>    <dbl>                  <dbl> <fct>                     
## 1 2021  AK       24.4                      41 most lax                  
## 2 2021  AL       25.1                      31 lax                       
## 3 2021  AR       22.8                      50 most lax                  
## 4 2021  AZ       18.2                      42 most lax                  
## 5 2021  CA        9.18                      1 most strict               
## 6 2021  CO       17.2                      13 strict                    
## # ℹ 1 more variable: gun_laws_strength_value <dbl>
# Save to a specific folder (replace "path/to/your/folder" with the actual folder path)
#write.csv(final_firearm_mortality_df, "F:\\CUNY masters\\data608\\major assignment_03\\output_file1.csv")

Data visualization:

Scatterplot

# Excluding DC's row as DC rank data not found
#final_firearm_mortality_df<-slice(final_firearm_mortality_df,-8)
# Plot a scatterplot showing labels for state, gun laws strength category, rank, and avg mortality rate
scatterplot <- ggplot(final_firearm_mortality_df, aes(x = gun_laws_strength_rank, y = avg_rate, label = state, color = gun_laws_strength_category)) +
  geom_point() +
  geom_text(hjust = 0, nudge_x = 0.1, nudge_y = 0.05) +
  labs(title = "Gun control laws strength by US states for year 2021",
       x = "gun control laws strength rank",
       y = "fire-arm related death rate") +
  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

The plot above illustrates that Massachusetts, with its most lax gun laws, has the highest firearm-related death rate, while Mississippi, with the strictest gun control laws, has the lowest death rate.

Bar chart

# Calculate average rate for each gun laws strength category
avg_rate_by_category <- final_firearm_mortality_df %>%
  group_by(gun_laws_strength_category) %>%
  summarize(Average_Rate = mean(avg_rate))

# Set colors for each category
category_colors <- c("red", "orange", "yellow", "green", "blue")

# Create a custom color scale for legend
color_scale <- scale_fill_manual(values = category_colors)

# Create bar chart
bar_chart <- ggplot(avg_rate_by_category, aes(x = gun_laws_strength_category, y = Average_Rate, fill = gun_laws_strength_category)) +
  geom_bar(stat = "identity") +
  labs(title = " Fire-arm related death rate by gun control laws strength category for year 2021", x = "gun laws strength category", y = "average fire-arm death rate") +
  color_scale

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

# Show bar chart
bar_chart

From the visualizations, it is observed that states with the most lax gun laws experience the highest firearm-related death rates, while states with the most strict gun laws have the lowest death rates. Overall, the bar chart reflects that stricter gun laws are associated with lower death rates, although there is a slightly higher death rate in states with strict gun laws compared to those with moderately strengthened gun laws. This exception may be due to factors not considered in this analysis, which vary among the states. In conclusion, it can be said that stricter firearm control laws contribute to a reduction in firearm mortality rates in U.S. states in 2021.

Heatmap

# Set colors for each gun control laws strength category
category_colors <- c(
  "most strict" = "red",
  "strict" = "orange",
  "moderate" = "yellow",
  "lax" = "green",
  "most lax" = "blue"
)

# Create Plotly heat map
heatmap <- plot_geo(final_firearm_mortality_df, locationmode = 'USA-states') %>%
  add_trace(
    z = final_firearm_mortality_df$gun_laws_strength_value,
    locations = final_firearm_mortality_df$state,
    color = final_firearm_mortality_df$gun_laws_strength_value,
    colors = category_colors,
    text = ~paste("State: ", state, "<br>Category: ", gun_laws_strength_category,"<br>Death Rate: ", avg_rate),
    hoverinfo = "text"
  )

# Customize layout
heatmap <- heatmap %>%
  layout(
    title = "Gun Laws Strength by US State for year 2021",
    geo = list(
      scope = 'usa',
      projection = list(type = 'albers usa'),
      showlakes = TRUE,
      lakecolor = toRGB('white')
    )
  ) 

# Add colorbar legend
heatmap <- heatmap %>%
  colorbar(
    title = "Gun Laws Strength Category",
    tickvals = 1:5,
    ticktext = c("most strict", "strict", "moderate", "lax", "most lax"),
    ticks = "outside"
  )

# Show heatmap
heatmap