Story 3

In this story, I’ll use CDC API to retrieve firearm mortality data for each state per 100,000 persons. Then, after categorizing gun control laws per states, we’ll create a 5-point Likert scale categorizing gun control laws from most lax to strictest.

The goal of the story is to answer if stricter firearm control laws help reduce firearm mortality

Import libraries

library(tidyverse)
library(httr)
library(jsonlite)
library(ggplot2)
library(tidyr)
library(usmap)
library(gridExtra)
library(kableExtra)

Load the data

Let’s access the firearm mortality data from the CDC using an available API (https://open.cdc.gov/apis.html)

url <- "https://data.cdc.gov/resource/489q-934x.json"
response <- GET(url)
data <- content(response, as = "text")
df <- as.data.frame(fromJSON(data))

# View data
kable(head(df), "simple")

year_and_quarter	time_period	cause_of_death	rate_type	unit	rate_overall	rate_sex_female	rate_sex_male	rate_alaska	rate_alabama	rate_arkansas	rate_arizona	rate_california	rate_colorado	rate_connecticut	rate_district_of_columbia	rate_delaware	rate_florida	rate_georgia	rate_hawaii	rate_iowa	rate_idaho	rate_illinois	rate_indiana	rate_kansas	rate_kentucky	rate_louisiana	rate_massachusetts	rate_maryland	rate_maine	rate_michigan	rate_minnesota	rate_missouri	rate_mississippi	rate_montana	rate_north_carolina	rate_north_dakota	rate_nebraska	rate_new_hampshire	rate_new_jersey	rate_new_mexico	rate_nevada	rate_new_york	rate_ohio	rate_oklahoma	rate_oregon	rate_pennsylvania	rate_rhode_island	rate_south_carolina	rate_south_dakota	rate_tennessee	rate_texas	rate_utah	rate_virginia	rate_vermont	rate_washington	rate_wisconsin	rate_west_virginia	rate_wyoming	rate_age_1_4	rate_age_5_14	rate_age_15_24	rate_age_25_34	rate_age_35_44	rate_age_45_54	rate_age_55_64	rate_65_74	rate_age_75_84	rate_age_85_plus
2021 Q1	12 months ending with quarter	All causes	Age-adjusted	Deaths per 100,000	866.3	716.3	1040.4	779.2	1123.4	1043.1	853.2	767.7	760.9	784.3	904.8	866.2	757.3	957.4	585.9	848.3	789.6	861.5	981.8	901.2	1064.2	1080.3	768	847.9	785.3	911.2	737.8	956.2	1197	836.6	893.7	835.5	822.7	744.9	853.1	952.7	895.2	817.6	983.2	1063.5	751.4	895.1	828.9	981.9	882.7	1056.8	922	771.2	824.8	737.9	714.8	825.8	1096.9	854	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA
2021 Q1	12 months ending with quarter	Alzheimer disease	Age-adjusted	Deaths per 100,000	32.1	36.8	24.8	28.2	51.2	44.1	31.3	41	36	20.6	11.1	35.4	19.7	45.9	22.4	29.7	37	28.3	32	24.2	31.7	45.3	17.8	16	27.6	36.3	32.9	33.9	58.3	22.6	36.8	37.6	32	25.8	22.2	25.9	27.5	14	37.5	36.6	36.4	23.5	32	40	37.4	42.8	44.9	41.1	28.3	34.3	42	31.7	35.2	32.1	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA
2021 Q1	12 months ending with quarter	COVID-19	Age-adjusted	Deaths per 100,000	120.7	94	153.9	44.4	160.2	130.6	142.1	128.5	83.6	138.9	148.6	106.8	80.6	130.5	20.7	119.9	79.2	121.3	132.8	121.8	109.6	146.7	126	111	36.1	101.7	85.1	113	171.5	91.8	99.3	132.8	101.3	60.9	172.6	144.1	133.4	174.2	122.2	157.8	37.1	123	138.4	126.6	145.8	122.5	162.3	68.7	92	21.5	46.5	86.1	94.2	84	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA
2021 Q1	12 months ending with quarter	Cancer	Age-adjusted	Deaths per 100,000	142	122.8	167.7	143	160.5	160.7	125.5	128.5	123.4	132.1	136	149.1	134.4	145.8	124.1	145.4	135	148.2	160.6	148.1	177	158.1	132.8	139.5	157.5	155.5	136.4	157.4	172	136	146	136.7	143.3	143.8	129.8	130	143.1	125.7	157.6	167.7	146.9	150.8	141.3	150.5	147	161.9	137	116.2	144.3	151.9	139.8	146.9	176.3	138	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA
2021 Q1	12 months ending with quarter	Chronic liver disease and cirrhosis	Age-adjusted	Deaths per 100,000	13.9	9.8	18.3	23.6	17.2	15.9	18.2	14.9	18.1	12.7	9	10.6	13.4	12.5	8.6	11.9	16	11.5	14.4	15.4	17.5	11.1	11.5	9.6	14.2	14.5	14	12.9	16.3	21.6	13.1	17.9	14	12.5	9.7	36.8	16.6	8.3	13.1	18.9	16.5	10.4	13.7	16.3	29	16.8	16.4	10.7	11.8	12	15	12.8	17.4	29.1	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA
2021 Q1	12 months ending with quarter	Chronic lower respiratory diseases	Age-adjusted	Deaths per 100,000	33.8	30.9	37.5	28.4	50.4	57.5	34.5	26.3	36.6	22.5	18.9	32	31.2	39.5	16.9	35.9	36.8	31.3	49.5	40.9	52.7	38.9	25.2	25.3	36.8	38.5	28.3	43.4	56.7	38.8	35.4	32.1	40.2	30.5	22.8	38	40.6	22.9	40.4	56.3	32.4	30.2	24.1	41.9	33.6	47.6	34.3	30.2	29.9	33	27.5	32.4	56	51.2	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA

Data Tidying

Let’s filter the data to only include injury per firearm in 2023 Quarter 1, 12 months ending quarter, Age adjusted

# Apply the filter to the data
firearm_data <- df %>% 
    filter(cause_of_death == 'Firearm-related injury' &
         year_and_quarter == '2023 Q1' &
         time_period == '12 months ending with quarter' &
         rate_type == "Age-adjusted")

#Select only the states columns
firearm_df <- firearm_data[1, 9:59]

# Reformat the data
firearm_df <- firearm_df %>%
  gather(key = "state", value = "firearm_mortality_rate", starts_with("rate_")) %>%
  mutate(firearm_mortality_rate = as.numeric(firearm_mortality_rate),
         state = gsub("rate_", "", state)) %>% 
  filter(state != "district_of_columbia") %>% 
  arrange(state)

# View first 5 elements of the data
head(firearm_df)

##        state firearm_mortality_rate
## 1    alabama                   26.4
## 2     alaska                   21.4
## 3    arizona                   20.0
## 4   arkansas                   22.7
## 5 california                    8.6
## 6   colorado                   17.0

Now, let’s create a 5 point Likert scale categorizing gun control laws from loosest to strictest and assign each state to the most appropriate Likert bins

• Reference: “https://wisevoter.com/state-rankings/states-with-strictest-gun-laws/#”

# Categories for  guns policies per states
likert_values <-c("Very loose", "Very loose","Very loose","Very loose","Very Strict",
                  "Strict","Very Strict","Strict","Moderate","Very loose",
                  "Very Strict","Very loose","Very Strict","Loose","Very loose",
                  "Very loose","Very loose","Very loose","Very loose","Very Strict",
                  "Very Strict","Moderate","Moderate","Very loose","Very loose","Very loose",
                  "Moderate","Moderate","Very loose","Very Strict","Moderate","Very Strict",
                  "Moderate","Very loose","Loose","Very loose","Strict","Strict",
                  "Strict","Very loose","Very loose","Very loose","Very loose",
                  "Very loose","Moderate","Strict","Strict","Very loose","Moderate","Very loose")

# Assuming your data frame is named df_ordered
firearm_df$gun_law <- likert_values

# Change the name of the column

firearm_df$state <- c("Alabama", "Alaska", "Arizona", "Arkansas", "California", 
            "Colorado", "Connecticut", "Delaware", "Florida", "Georgia", 
            "Hawaii", "Idaho", "Illinois", "Indiana", "Iowa", "Kansas", 
            "Kentucky", "Louisiana", "Maine", "Maryland", "Massachusetts", 
            "Michigan", "Minnesota", "Mississippi", "Missouri", "Montana", 
            "Nebraska", "Nevada", "New Hampshire", "New Jersey", "New Mexico", 
            "New York", "North Carolina", "North Dakota", "Ohio", "Oklahoma", 
            "Oregon", "Pennsylvania", "Rhode Island", "South Carolina", 
            "South Dakota", "Tennessee", "Texas", "Utah", "Vermont", "Virginia", 
            "Washington", "West Virginia", "Wisconsin", "Wyoming")

# Print the data 
head(firearm_df)

##        state firearm_mortality_rate     gun_law
## 1    Alabama                   26.4  Very loose
## 2     Alaska                   21.4  Very loose
## 3    Arizona                   20.0  Very loose
## 4   Arkansas                   22.7  Very loose
## 5 California                    8.6 Very Strict
## 6   Colorado                   17.0      Strict

Data Visualization

Correlation between firearm policy and mortality rate

Let’s calculate the correlation between strict firearm policy and the mortality rate.

# Calculate correlation coefficient
correlation <- cor(firearm_df$firearm_mortality_rate, as.numeric(factor(firearm_df$gun_law, levels = c("Very loose", "Loose", "Moderate", "Strict", "Very Strict"))))

correlation

## [1] -0.6656803

The correlation coefficient of -0.6656803 indicates a strong negative correlation between firearm mortality rates and the stringency of gun control laws. This suggests that as gun control laws become stricter, firearm mortality rates tend to decrease.

Create a heat map

Let’s visualize the relationship between gun control laws and firearm mortality rate

# Plot US map for firearm mortality rates
plot_firearm <- plot_usmap(data = firearm_df, values = "firearm_mortality_rate", color = "orange", labels = FALSE) + 
  scale_fill_continuous(low = "white", high = "orange", name = "Firearm Mortality Rate", label = scales::comma) + 
  theme(legend.position = "bottom", panel.background = element_rect(colour = "black")) + 
  labs(title = "Firearm Mortality Rate by State")

# Plot US map for gun control laws
plot_gun_law <- plot_usmap(data = firearm_df, values = "gun_law", color = "orange", labels = FALSE) + 
  scale_fill_manual(values = c("#F0F0F0", "#000000", "#404040", "#808080","#C0C0C0"),
                    name = "Gun Control",
                    breaks = unique(firearm_df$gun_law)) + 
  theme(legend.position = "bottom",
        panel.background = element_rect(colour = "black"),
        legend.key.size = unit(0.1, "cm")) + 
  labs(title = "Gun Control Laws by State")

# Arrange plots side by side
grid.arrange(plot_firearm, plot_gun_law, ncol = 2)

The heat map shows that the states with the most strictest guns laws have a lower mortality rates.

Conclusion

In this story, we aim to explore the impact of stricter firearm control laws on reduce firearm mortality rates. Through correlating the strictness of firearm control laws across states with their respective firearm mortality rates and visualizing the data via a heat map, we observe a notable trend: As gun control laws tighten, firearm mortality rates generally decreases.

# Calculate the average firearm mortality rate
average_rate <- mean(firearm_df$firearm_mortality_rate)


# Reorder the factor levels of gun_law
firearm_df$gun_law <- factor(firearm_df$gun_law, levels = c("Very Strict", "Strict", "Moderate", "Loose", "Very loose"))

# Create the scatter plot
ggplot(firearm_df, aes(x = gun_law, y = firearm_mortality_rate, label = state)) +
  geom_point(aes(color = ifelse(firearm_mortality_rate > average_rate,  "Above Average", "Below Average")), size = 1) +
  geom_text(size = 2, hjust = -0.5) +  
  scale_color_manual(values = c( "red", "grey")) +
  labs(x = "Gun Control Laws", y = "Firearm Mortality Rate", title = "Firearm Mortality Rate vs. Gun Control Laws") +
  geom_hline(yintercept = average_rate, linetype = "dotted") + 
  theme_minimal() +
  guides(color = guide_legend(title = "Mortality Rate", 
                              )) 

The national average for firearm mortality stands at 15.5 per 100,000 persons.

The above graph shows that:

• States characterized by very strict gun control laws consistently have firearm mortality rates below the national average.

• Conversely, over 70% of states categorized as having lenient gun control laws surpass the national average in firearm mortality rates.

• Moreover, Off of the 21 states in the US that have firearm mortality rates above the national average, 16 states have very loose gun control laws.

Although it’s important to consider other factors that could contribute to lower mortality rates in these states, the data suggests that stricter gun control laws correspond to lower firearm mortality rates.

---