Ross Boehme - DATA608 - Story 3
Assignment: Do stricter gun laws reduce firearm gun deaths? The CDC publishes firearm mortality for each state per 100,000 persons. Each state’s 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?”
- Access the firearm mortality data from the CDC using an available API
- 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
Notes: - You may not use the same desktop application that you have used for a previous story. - If you use color in your visuals you must use an accessible color palette.
library(httr)## Warning: package 'httr' was built under R version 4.2.3library(jsonlite)
library(tidyverse)## ── Attaching packages ─────────────────────────────────────── tidyverse 1.3.2 ──
## ✔ ggplot2 3.4.0 ✔ purrr 1.0.1
## ✔ tibble 3.1.8 ✔ dplyr 1.1.0
## ✔ tidyr 1.3.0 ✔ stringr 1.5.0
## ✔ readr 2.1.4 ✔ forcats 0.5.2
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ purrr::flatten() masks jsonlite::flatten()
## ✖ dplyr::lag() masks stats::lag()library(plotly)## Warning: package 'plotly' was built under R version 4.2.3##
## Attaching package: 'plotly'
##
## The following object is masked from 'package:ggplot2':
##
## last_plot
##
## The following object is masked from 'package:httr':
##
## config
##
## The following object is masked from 'package:stats':
##
## filter
##
## The following object is masked from 'package:graphics':
##
## layoutlibrary(ggplot2)
library(maps)## Warning: package 'maps' was built under R version 4.2.3##
## Attaching package: 'maps'
##
## The following object is masked from 'package:purrr':
##
## maplibrary(patchwork)## Warning: package 'patchwork' was built under R version 4.2.3Retrieving data, confirming it’s a dataframe, and showing the initial structure. Currently contains extra columns, longitudinal data, and deaths unrelated to guns.
df <- fromJSON(content(GET("https://data.cdc.gov/resource/489q-934x.json"), "text"))
df <- as.data.frame(df)
head(df)## year_and_quarter time_period
## 1 2021 Q1 12 months ending with quarter
## 2 2021 Q1 12 months ending with quarter
## 3 2021 Q1 12 months ending with quarter
## 4 2021 Q1 12 months ending with quarter
## 5 2021 Q1 12 months ending with quarter
## 6 2021 Q1 12 months ending with quarter
## cause_of_death rate_type unit
## 1 All causes Age-adjusted Deaths per 100,000
## 2 Alzheimer disease Age-adjusted Deaths per 100,000
## 3 COVID-19 Age-adjusted Deaths per 100,000
## 4 Cancer Age-adjusted Deaths per 100,000
## 5 Chronic liver disease and cirrhosis Age-adjusted Deaths per 100,000
## 6 Chronic lower respiratory diseases Age-adjusted Deaths per 100,000
## rate_overall rate_sex_female rate_sex_male rate_alaska rate_alabama
## 1 866.3 716.3 1040.4 779.2 1123.4
## 2 32.1 36.8 24.8 28.2 51.2
## 3 120.7 94 153.9 44.4 160.2
## 4 142 122.8 167.7 143 160.5
## 5 13.9 9.8 18.3 23.6 17.2
## 6 33.8 30.9 37.5 28.4 50.4
## rate_arkansas rate_arizona rate_california rate_colorado rate_connecticut
## 1 1043.1 853.2 767.7 760.9 784.3
## 2 44.1 31.3 41 36 20.6
## 3 130.6 142.1 128.5 83.6 138.9
## 4 160.7 125.5 128.5 123.4 132.1
## 5 15.9 18.2 14.9 18.1 12.7
## 6 57.5 34.5 26.3 36.6 22.5
## rate_district_of_columbia rate_delaware rate_florida rate_georgia rate_hawaii
## 1 904.8 866.2 757.3 957.4 585.9
## 2 11.1 35.4 19.7 45.9 22.4
## 3 148.6 106.8 80.6 130.5 20.7
## 4 136 149.1 134.4 145.8 124.1
## 5 9 10.6 13.4 12.5 8.6
## 6 18.9 32 31.2 39.5 16.9
## rate_iowa rate_idaho rate_illinois rate_indiana rate_kansas rate_kentucky
## 1 848.3 789.6 861.5 981.8 901.2 1064.2
## 2 29.7 37 28.3 32 24.2 31.7
## 3 119.9 79.2 121.3 132.8 121.8 109.6
## 4 145.4 135 148.2 160.6 148.1 177
## 5 11.9 16 11.5 14.4 15.4 17.5
## 6 35.9 36.8 31.3 49.5 40.9 52.7
## rate_louisiana rate_massachusetts rate_maryland rate_maine rate_michigan
## 1 1080.3 768 847.9 785.3 911.2
## 2 45.3 17.8 16 27.6 36.3
## 3 146.7 126 111 36.1 101.7
## 4 158.1 132.8 139.5 157.5 155.5
## 5 11.1 11.5 9.6 14.2 14.5
## 6 38.9 25.2 25.3 36.8 38.5
## rate_minnesota rate_missouri rate_mississippi rate_montana
## 1 737.8 956.2 1197 836.6
## 2 32.9 33.9 58.3 22.6
## 3 85.1 113 171.5 91.8
## 4 136.4 157.4 172 136
## 5 14 12.9 16.3 21.6
## 6 28.3 43.4 56.7 38.8
## rate_north_carolina rate_north_dakota rate_nebraska rate_new_hampshire
## 1 893.7 835.5 822.7 744.9
## 2 36.8 37.6 32 25.8
## 3 99.3 132.8 101.3 60.9
## 4 146 136.7 143.3 143.8
## 5 13.1 17.9 14 12.5
## 6 35.4 32.1 40.2 30.5
## rate_new_jersey rate_new_mexico rate_nevada rate_new_york rate_ohio
## 1 853.1 952.7 895.2 817.6 983.2
## 2 22.2 25.9 27.5 14 37.5
## 3 172.6 144.1 133.4 174.2 122.2
## 4 129.8 130 143.1 125.7 157.6
## 5 9.7 36.8 16.6 8.3 13.1
## 6 22.8 38 40.6 22.9 40.4
## rate_oklahoma rate_oregon rate_pennsylvania rate_rhode_island
## 1 1063.5 751.4 895.1 828.9
## 2 36.6 36.4 23.5 32
## 3 157.8 37.1 123 138.4
## 4 167.7 146.9 150.8 141.3
## 5 18.9 16.5 10.4 13.7
## 6 56.3 32.4 30.2 24.1
## rate_south_carolina rate_south_dakota rate_tennessee rate_texas rate_utah
## 1 981.9 882.7 1056.8 922 771.2
## 2 40 37.4 42.8 44.9 41.1
## 3 126.6 145.8 122.5 162.3 68.7
## 4 150.5 147 161.9 137 116.2
## 5 16.3 29 16.8 16.4 10.7
## 6 41.9 33.6 47.6 34.3 30.2
## rate_virginia rate_vermont rate_washington rate_wisconsin rate_west_virginia
## 1 824.8 737.9 714.8 825.8 1096.9
## 2 28.3 34.3 42 31.7 35.2
## 3 92 21.5 46.5 86.1 94.2
## 4 144.3 151.9 139.8 146.9 176.3
## 5 11.8 12 15 12.8 17.4
## 6 29.9 33 27.5 32.4 56
## rate_wyoming rate_age_1_4 rate_age_5_14 rate_age_15_24 rate_age_25_34
## 1 854 <NA> <NA> <NA> <NA>
## 2 32.1 <NA> <NA> <NA> <NA>
## 3 84 <NA> <NA> <NA> <NA>
## 4 138 <NA> <NA> <NA> <NA>
## 5 29.1 <NA> <NA> <NA> <NA>
## 6 51.2 <NA> <NA> <NA> <NA>
## rate_age_35_44 rate_age_45_54 rate_age_55_64 rate_65_74 rate_age_75_84
## 1 <NA> <NA> <NA> <NA> <NA>
## 2 <NA> <NA> <NA> <NA> <NA>
## 3 <NA> <NA> <NA> <NA> <NA>
## 4 <NA> <NA> <NA> <NA> <NA>
## 5 <NA> <NA> <NA> <NA> <NA>
## 6 <NA> <NA> <NA> <NA> <NA>
## rate_age_85_plus
## 1 <NA>
## 2 <NA>
## 3 <NA>
## 4 <NA>
## 5 <NA>
## 6 <NA>Initial filtering of dataframe
#Only looking at firearm deaths at yearly cadence; not interested in rate per age in this analysis
#Looking at only most recent full year of data (2022)
firearm <- df %>%
filter(cause_of_death == "Firearm-related injury" &
time_period == "12 months ending with quarter" &
rate_type == "Crude" &
year_and_quarter == "2022 Q4")
firearm <- firearm %>%
select(-starts_with("rate_age"), -rate_overall, -rate_sex_female, -rate_sex_male,
-rate_65_74, -cause_of_death, -time_period, -rate_type, -unit, -year_and_quarter)My dataframe now only contains the average firearm related deaths for 2022 per state. To better organize this dataframe (for more efficient data access), I’ll rename the states to their abbreviations and pivot the df longer.
#Create vector to map state names to abbreviations
state.abb <- c(
"alabama" = "AL", "alaska" = "AK", "arizona" = "AZ", "arkansas" = "AR", "california" = "CA",
"colorado" = "CO", "connecticut" = "CT", "delaware" = "DE", "district_of_columbia" = "DC",
"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",
"west_virginia" = "WV", "virginia" = "VA", "washington" = "WA", "wisconsin" = "WI", "wyoming" = "WY"
)
#Replace state names with abbreviations in column names
new_colnames <- colnames(firearm)
for (state in names(state.abb)) {
new_colnames <- gsub(state, state.abb[state], new_colnames, ignore.case = TRUE)
}
colnames(firearm) <- new_colnames
colnames(firearm) <- gsub("^rate_", "", colnames(firearm))
#Pivot longer
firearm <- pivot_longer(firearm, everything(), names_to = "state", values_to = "mortality_rate")
#Add column "year" to specify this is for 2022 data
firearm$year <- "2022"
#Assign double data type to injury_rate column
firearm$mortality_rate <- as.numeric(firearm$mortality_rate)Showing cleaned firearm injury rate dataframe for 2022 per state (and D.C.)
colnames(firearm) <- c("state_abbr", "mortality_rate", "year")
head(firearm)## # A tibble: 6 × 3
## state_abbr mortality_rate year
## <chr> <dbl> <chr>
## 1 AK 22.4 2022
## 2 AL 25.2 2022
## 3 AR 21.9 2022
## 4 AZ 20.9 2022
## 5 CA 8.9 2022
## 6 CO 17.7 2022I couldn’t easily find API-accessible information on gun law strength rankings. The most credible source I found was the Gifford rankings. Uploaded to my personal Github then read below. Manually added District of Columbia (DC) which wasn’t in the Gifford rankings but would be an “A” according to their “strongest gun laws in the country” (Everytown for Gun Safety).
safety <- read_csv('https://raw.githubusercontent.com/rossboehme/DATA608/main/giffords_2024_gun_law_strength_rankings.csv',show_col_types=FALSE)
safety <- as.data.frame(safety)
#Showing initial dataframe
head(safety)## gun_law_strength state gun_law_grade Gun Death Rate (Ranked)
## 1 1 California A 44
## 2 2 New Jersey A 47
## 3 3 Connecticut A 45
## 4 4 Illinois A- 32
## 5 5 New York A- 46
## 6 6 Hawaii A- 48
## Gun Death Rate (Per 100K)
## 1 8.7
## 2 5.0
## 3 7.0
## 4 14.4
## 5 5.3
## 6 4.5Cleaning gun safety law rankings:
- Only relevant data (state names and grades from A to F)
- No spaces in column names - Mapping grades to Likert scale where 1 =
most lax (“F” grade) and 5 = strictest (“A” grade)
- Manually adding D.C. rankings which weren’t in my original
source
safety <- safety %>% select(gun_law_grade, state)
safety <- safety %>%
mutate(strictness_rating = case_when(
str_detect(gun_law_grade, "A") ~ 5,
str_detect(gun_law_grade, "B") ~ 4,
str_detect(gun_law_grade, "C") ~ 3,
str_detect(gun_law_grade, "D") ~ 2,
TRUE ~ 1
))
safety$state_abbr <- sapply(safety$state, function(x) {
switch(x,
"Alabama" = "AL", "Alaska" = "AK", "Arizona" = "AZ", "Arkansas" = "AR", "California" = "CA",
"Colorado" = "CO", "Connecticut" = "CT", "Delaware" = "DE", "District of Columbia" = "DC",
"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",
"West Virginia" = "WV", "Virginia" = "VA", "Washington" = "WA", "Wisconsin" = "WI", "Wyoming" = "WY",
NA)
})
#Display the updated dataframe
safety <- safety %>% select(state, state_abbr, strictness_rating)
#Manually add DC
safety <- rbind(safety, data.frame(state = "District of Columbia", state_abbr = "DC", strictness_rating = 5))
#Showing final "safety" dataframe
head(safety)## state state_abbr strictness_rating
## 1 California CA 5
## 2 New Jersey NJ 5
## 3 Connecticut CT 5
## 4 Illinois IL 5
## 5 New York NY 5
## 6 Hawaii HI 5Now I’ll merge my firearm mortality dataframe with my gun safety rating dataframe.
merged <- merge(firearm, safety, by = "state_abbr")
print(merged)## state_abbr mortality_rate year state strictness_rating
## 1 AK 22.4 2022 Alaska 1
## 2 AL 25.2 2022 Alabama 1
## 3 AR 21.9 2022 Arkansas 1
## 4 AZ 20.9 2022 Arizona 1
## 5 CA 8.9 2022 California 5
## 6 CO 17.7 2022 Colorado 5
## 7 CT 6.9 2022 Connecticut 5
## 8 DC 22.9 2022 District of Columbia 5
## 9 DE 12.2 2022 Delaware 4
## 10 FL 14.5 2022 Florida 2
## 11 GA 19.8 2022 Georgia 1
## 12 HI 4.6 2022 Hawaii 5
## 13 IA 11.5 2022 Iowa 1
## 14 ID 17.4 2022 Idaho 1
## 15 IL 14.3 2022 Illinois 5
## 16 IN 17.7 2022 Indiana 2
## 17 KS 16.8 2022 Kansas 1
## 18 KY 18.6 2022 Kentucky 1
## 19 LA 27.6 2022 Louisiana 1
## 20 MA 3.8 2022 Massachusetts 5
## 21 MD 13.2 2022 Maryland 5
## 22 ME 12.9 2022 Maine 2
## 23 MI 15.0 2022 Michigan 4
## 24 MN 9.8 2022 Minnesota 4
## 25 MO 24.1 2022 Missouri 1
## 26 MS 28.8 2022 Mississippi 1
## 27 MT 24.4 2022 Montana 1
## 28 NC 17.0 2022 North Carolina 3
## 29 ND 16.0 2022 North Dakota 1
## 30 NE 12.4 2022 Nebraska 3
## 31 NH 11.2 2022 New Hampshire 2
## 32 NJ 5.1 2022 New Jersey 5
## 33 NM 27.0 2022 New Mexico 3
## 34 NV 19.4 2022 Nevada 4
## 35 NY 5.3 2022 New York 5
## 36 OH 15.6 2022 Ohio 2
## 37 OK 19.8 2022 Oklahoma 1
## 38 OR 15.4 2022 Oregon 5
## 39 PA 15.0 2022 Pennsylvania 4
## 40 RI 3.4 2022 Rhode Island 4
## 41 SC 20.9 2022 South Carolina 2
## 42 SD 15.5 2022 South Dakota 1
## 43 TN 21.0 2022 Tennessee 1
## 44 TX 15.4 2022 Texas 1
## 45 UT 13.2 2022 Utah 1
## 46 VA 15.1 2022 Virginia 4
## 47 VT 13.0 2022 Vermont 4
## 48 WA 13.1 2022 Washington 5
## 49 WI 14.1 2022 Wisconsin 3
## 50 WV 17.5 2022 West Virginia 1
## 51 WY 21.3 2022 Wyoming 1I will create an initial visualization to show the association between Firearm Deaths Per 100K people and Firearm Law Strictness. There appears to be a general inverse relationship: the higher the gun law strictness (5 is highest), the lower the mortality rate.
ggplot(data = merged, aes(x = strictness_rating, y = mortality_rate)) +
geom_point(aes(color = 'U.S. State'), size = 3) +
geom_smooth(method = "lm", se = FALSE, aes(color = "Trend")) +
guides(color = guide_legend(override.aes = list(linetype = 1), title = "")) +
labs(title = "Firearm Deaths vs. Firearm Law Strictness by U.S. State",
x = "Strictness Rating (5 is strictest)",
y = "Deaths Per 100K People") +
theme(plot.title = element_text(face = "bold",hjust=0.5))## `geom_smooth()` using formula = 'y ~ x'
Next I’ll bring in state information from the maps package so I can create a heatmap as requested.
#Retrieve state info from maps package
state_info <- map_data("state")
#Merge mortality/law data with map data
merged$region <- tolower(merged$state)
gun_map <- left_join(state_info, merged, by = "region")For my U.S. heatmap, I will use accessible color palettes (for people with color blindness) as defined by David Nichols. Red/blue is more visible than red/green.
In this combined plot, I juxtapose the Firearm Deaths Per State map against the Firearm Law Strictness Per State map. There appears to be an association between higher firearm mortality rates (per 100K population) and more lax gun laws, both of which are displayed in red. Likewise, lower mortality rates (blue) show up in states with stricter gun laws (blue).
p1 <- ggplot(gun_map, aes(x = long, y = lat, group = group, fill = mortality_rate)) +
geom_polygon() +
scale_fill_gradient(low = "#005AB5", high = '#DC3220') +
coord_map() +
theme_void() +
labs(title = "Firearm Deaths Per State",
caption = "",
fill = "Mortality Rate
(Per 100K People)") +
theme(
plot.title = element_text(face = "bold", hjust = 0.5),
legend.title.align = 0.5,
legend.position = "bottom",
legend.box = "vertical"
)
p2 <- ggplot(gun_map, aes(x = long, y = lat, group = group, fill = strictness_rating)) +
geom_polygon() +
scale_fill_gradient(low = "#DC3220", high = '#005AB5') +
coord_map() +
theme_void() +
labs(title = "Firearm Law Strictness Per State",
caption = "",
fill = "Strictness Rating
(5 is strictest)") +
theme(
plot.title = element_text(face = "bold", hjust = 0.5),
legend.title.align = 0.5,
legend.position = "bottom",
legend.box = "vertical"
)
combined_plot <- p1 / p2 + plot_layout(heights = c(2, 2))
combined_plot 