Do stricter gun laws reduce firearm gun deaths?

Introduction

A major goal of having gun laws is to protect lives. Whether or not this works is important for us to know when evaluating the direction of legislation. We will use a five point Likert scale to rank the gun laws per states by: Very Lax, Lax, Neutral, Strict, Very Strict. The expectation is that the strictest states should have the lowest firearm death rates. A strict state is one that is defined by having a lot of current relevant laws compared to other states. Death rate is not as simple as a raw number because smaller states likely have fewer deaths. Instead, we use the total deaths per 100,000 people to account for population differences.

Abstract

Stricter gun laws reduce firearm gun deaths for American states according to the average deaths per 100,000 rate from 2022-2024. District of Columbia is not a state and appears to be an outlier. It does not seem to matter if the laws restrict gun ownership or are permissive such as license laws. The strongest correlations appear when comparing how the states with the most laws perform with every other state.

EDA and Data Cleaning

We will need data on each state’s current active laws and death data.

CDC_DEATH_URL <- 'https://data.cdc.gov/resource/489q-934x.json'
LAWS_PATH <- 'StateFirearmLaws.xlsx'
death_data <- fromJSON(CDC_DEATH_URL)
laws_data <- read_excel(LAWS_PATH, sheet = 2) %>% select(-Content, -`Statutory Citation`, -`Additional Context and Notes`)

kable(head(death_data))%>%
      kable_styling(bootstrap_options = 'striped', full_width = FALSE) %>%
      scroll_box(width = '100%')
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
2022 Q1 12 months ending with quarter All causes Age-adjusted Deaths per 100,000 873.2 729.4 1038 944.5 1109.8 1097.1 882.5 719.5 808.2 725.9 844.4 868.3 828 973.6 647.1 860.8 892.8 839.4 1011.9 938.4 1153.2 1084.4 717 800.3 910.3 956.2 771.6 986.6 1193.4 925.3 952.8 810.5 839.4 791.9 723.5 1007.9 933.3 694.4 1019.8 1126.4 875.6 893.5 771 1022 871.4 1122.6 918.3 822.2 860.1 800.5 811.1 857.1 1239.9 956.8 NA NA NA NA NA NA NA NA NA NA
2022 Q1 12 months ending with quarter Alzheimer disease Age-adjusted Deaths per 100,000 30.6 35 23.8 28.5 45.5 43.2 29.6 38.4 32.1 21.6 10.7 30.1 19.3 43.4 23.6 30.9 41.5 26.6 29.6 22.9 32.5 42.8 17.5 15.9 28.1 34.1 34.1 33.5 51.8 24.4 36 32.5 29.8 23.3 20.5 25.4 26.3 12.8 34 37.1 40 22.5 28.3 40.1 39.1 37.2 41.2 41 26.1 36.2 46 33.6 35.4 34.2 NA NA NA NA NA NA NA NA NA NA
2022 Q1 12 months ending with quarter COVID-19 Age-adjusted Deaths per 100,000 95 75.2 119.1 121.3 133.6 123.6 113.9 62.4 89.9 50.9 54.8 78.4 106.6 116.4 43.9 78.1 118.9 82.1 112.1 109.7 146.7 108.8 46.7 66.9 70.9 115 68 110.5 140.8 111.8 98.3 80.2 73.8 56.5 62.9 138.3 134.8 63.4 128.1 150.3 77.5 97.4 55.5 122.9 76.3 140.5 126.7 78.4 80.8 32.9 66.6 77.7 154 145.1 NA NA NA NA NA NA NA NA NA NA
2022 Q1 12 months ending with quarter Cancer Age-adjusted Deaths per 100,000 145.9 127.4 170.9 156 159.9 167.9 134.5 131.4 125 134.1 143.8 155.4 141.3 150.4 126.7 152 139.6 149.3 169 152.8 179.6 161.9 136.1 139.2 161.2 159.6 143.6 162.4 184 142.9 152.4 134.2 152.2 145.3 130.3 135.6 140.8 125.3 161.5 176.7 153.7 151.8 139.1 154.3 148.6 165.2 143.5 120.6 149.8 155 148.5 146.7 183.8 153.1 NA NA NA NA NA NA NA NA NA NA
2022 Q1 12 months ending with quarter Chronic liver disease and cirrhosis Age-adjusted Deaths per 100,000 14.4 10.3 18.9 25.5 16.4 17 21 15.4 19.7 12.5 9.1 11.5 13.4 13.7 9.7 14.3 16.1 12.3 15.4 15.4 17.2 12.1 11.1 9.3 17.8 15.1 13.6 13.1 17.3 24.7 15 17.8 15.2 14.5 8.9 41.8 17.6 8.3 14.1 19.3 18 11 16.8 17.5 36.1 17.1 16.8 11.6 11.7 12.6 15.5 12.5 17.9 25 NA NA NA NA NA NA NA NA NA NA
2022 Q1 12 months ending with quarter Chronic lower respiratory diseases Age-adjusted Deaths per 100,000 35.1 33.2 37.8 36.4 51.7 62.3 37 26.3 38.1 23.9 17.7 36.5 32.1 41.1 17.9 40.8 44.1 32.4 52.9 43.8 58.3 39.6 26.8 24.1 43.1 39 30.1 46.7 59.9 39.6 37.3 35.4 41 36 21.6 38.3 41.4 22.5 43 63.5 34.1 30.8 29.4 41.6 41.6 52 36.2 30.6 31.3 32.4 29.5 33.2 59.9 49.5 NA NA NA NA NA NA NA NA NA NA 
kable(describe(death_data))%>%
      kable_styling(bootstrap_options = 'striped', full_width = FALSE) %>%
      scroll_box(width = '100%', height = '500px')
vars n mean sd median trimmed mad min max range skew kurtosis se
year_and_quarter 1 1000 6.45600 3.4321777 6.0 6.455000 4.4478 1 12 11 0.0055025 -1.2139772 0.1085350
time_period 2 1000 1.49600 0.5002342 1.0 1.495000 0.0000 1 2 1 0.0159765 -2.0017435 0.0158188
cause_of_death 3 1000 10.94800 6.0509429 11.0 10.938750 7.4130 1 21 20 0.0121427 -1.2047912 0.1913476
rate_type 4 1000 1.49600 0.5002342 1.0 1.495000 0.0000 1 2 1 0.0159765 -2.0017435 0.0158188
unit 5 1000 1.00000 0.0000000 1.0 1.000000 0.0000 1 1 0 NaN NaN 0.0000000
rate_overall 6 978 211.59100 157.1314648 204.0 203.243622 216.4596 1 509 508 0.2921679 -1.2544872 5.0245102
rate_sex_female 7 978 229.55010 147.2227719 219.5 227.964286 184.5837 1 484 483 0.0413413 -1.1852921 4.7076651
rate_sex_male 8 978 225.79346 149.6511203 214.0 219.562500 197.9271 1 526 525 0.2540911 -1.1075436 4.7853152
rate_alaska 9 922 250.64967 144.4741479 236.0 250.746612 177.9120 1 504 503 0.0399020 -1.0808416 4.7580027
rate_alabama 10 978 232.46830 154.0516786 215.5 225.764031 191.9967 1 543 542 0.3179733 -1.1143240 4.9260295
rate_arkansas 11 976 244.11270 163.0174557 212.0 237.496164 191.9967 1 563 562 0.3148187 -1.1115859 5.2180616
rate_arizona 12 978 255.37526 165.7785740 245.5 251.883929 208.3053 1 560 559 0.1352425 -1.1612217 5.3010143
rate_california 13 978 224.56237 159.6579208 223.0 219.043367 212.0118 1 503 502 0.1529507 -1.2618630 5.1052973
rate_colorado 14 976 246.27766 140.2635167 251.0 247.579284 158.6382 1 498 497 -0.1172047 -1.0136104 4.4897258
rate_connecticut 15 976 226.11270 158.1197197 214.5 220.484655 208.3053 1 515 514 0.1987619 -1.2403336 5.0612889
rate_district_of_columbia 16 974 271.61807 146.2713549 302.5 278.264103 171.2403 1 502 501 -0.3377269 -1.1137961 4.6868365
rate_delaware 17 960 260.66146 178.0588325 254.0 255.777344 256.4898 1 565 564 0.1346106 -1.3733060 5.7468241
rate_florida 18 978 241.60429 156.1506171 225.5 236.086735 194.9619 1 522 521 0.2760453 -1.2840364 4.9931461
rate_georgia 19 978 212.32209 146.1804718 196.0 206.466837 194.2206 1 485 484 0.2087123 -1.1613199 4.6743361
rate_hawaii 20 930 244.45914 147.1045883 234.5 243.662634 186.0663 1 500 499 0.0833032 -1.2174530 4.8237495
rate_iowa 21 936 223.45620 152.4862340 189.5 216.133333 174.2055 1 529 528 0.3532994 -1.1298000 4.9841685
rate_idaho 22 930 264.68925 149.7109637 258.5 266.512097 184.5837 1 528 527 -0.0585874 -1.1258119 4.9092159
rate_illinois 23 978 214.17587 162.8612063 205.5 206.857143 236.4747 1 503 502 0.2470564 -1.3553019 5.2077271
rate_indiana 24 978 245.67076 168.3109723 237.5 241.765306 224.6139 1 540 539 0.1752853 -1.3368962 5.3819914
rate_kansas 25 960 230.23229 154.6253139 207.5 223.390625 191.2554 1 538 537 0.3021373 -1.1635950 4.9905105
rate_kentucky 26 978 263.92127 174.6601055 255.5 259.789541 223.1313 1 586 585 0.1666005 -1.2502036 5.5850143
rate_louisiana 27 978 273.16360 173.6515701 273.5 269.608418 229.8030 1 588 587 0.1075531 -1.2750978 5.5527649
rate_massachusetts 28 978 226.30982 151.3969584 223.5 223.654337 206.0814 1 491 490 0.0821481 -1.2692655 4.8411409
rate_maryland 29 978 242.70859 170.8467681 230.0 240.895408 250.5594 1 502 501 0.0592556 -1.4244713 5.4630772
rate_maine 30 885 265.20113 165.5200846 241.0 261.313117 206.0814 1 575 574 0.1692672 -1.1534021 5.5638968
rate_michigan 31 978 233.73108 166.4092890 217.5 226.515306 209.7879 1 543 542 0.2876502 -1.2676272 5.3211823
rate_minnesota 32 978 244.71984 162.0558342 249.0 241.386480 209.0466 1 530 529 0.1113437 -1.2089020 5.1819742
rate_missouri 33 978 263.27403 171.5979823 255.0 259.932398 225.3552 1 571 570 0.1284587 -1.2551291 5.4870984
rate_mississippi 34 978 263.05317 162.8080585 237.0 256.980867 193.4793 1 582 581 0.3038465 -1.1262927 5.2060276
rate_montana 35 930 276.02796 152.6759913 277.0 277.137097 185.3250 1 548 547 -0.0668558 -1.0674010 5.0064430
rate_north_carolina 36 978 253.93763 172.2121623 238.5 249.298469 223.1313 1 564 563 0.1992815 -1.3308171 5.5067377
rate_north_dakota 37 926 242.45788 163.6387909 228.0 237.429919 214.2357 1 540 539 0.2205050 -1.2275915 5.3775043
rate_nebraska 38 936 211.59295 156.4851838 201.5 203.272000 216.4596 1 510 509 0.2928315 -1.2604519 5.1148782
rate_new_hampshire 39 924 254.96320 162.0475792 251.0 253.522973 216.4596 1 533 532 0.0827658 -1.2856432 5.3309740
rate_new_jersey 40 978 252.14417 152.4568321 262.0 255.417092 202.3749 1 485 484 -0.1252287 -1.2869183 4.8750319
rate_new_mexico 41 956 283.44979 166.9524953 278.5 281.345953 209.7879 1 596 595 0.0718501 -1.0874865 5.3996296
rate_nevada 42 978 264.09305 167.0177594 248.0 262.224490 213.4944 1 559 558 0.1135983 -1.2475075 5.3406390
rate_new_york 43 978 243.37321 144.7613530 254.5 245.628827 183.8424 1 473 472 -0.1164328 -1.2028755 4.6289576
rate_ohio 44 978 229.14110 163.8099747 208.5 223.173469 204.5988 1 531 530 0.2479266 -1.3473256 5.2380654
rate_oklahoma 45 978 276.27710 176.3910118 264.5 274.918367 228.3204 1 582 581 0.0470305 -1.2627072 5.6403626
rate_oregon 46 978 274.56135 166.4093768 268.5 272.451531 204.5988 1 586 585 0.0861201 -1.1098389 5.3211851
rate_pennsylvania 47 978 248.23006 171.7901627 235.5 243.788265 234.2508 1 549 548 0.1739367 -1.3522824 5.4932437
rate_rhode_island 48 924 274.74459 167.0375676 280.0 275.582432 217.9422 1 548 547 -0.0264200 -1.2709247 5.4951325
rate_south_carolina 49 978 246.19121 171.5788125 219.5 239.362245 220.1661 1 566 565 0.2560258 -1.2549111 5.4864854
rate_south_dakota 50 930 262.21075 166.6429399 268.5 261.079301 227.5791 1 546 545 0.0174732 -1.3003640 5.4644373
rate_tennessee 51 978 236.51943 164.2697189 201.0 228.331633 187.5489 1 569 568 0.3661691 -1.1215853 5.2527664
rate_texas 52 978 210.62168 146.8787579 197.5 206.428571 206.0814 1 468 467 0.1733633 -1.3674487 4.6966648
rate_utah 53 940 238.22340 144.5008562 222.0 235.599734 174.9468 1 500 499 0.1412664 -1.0824535 4.7130983
rate_virginia 54 978 215.64213 162.0109829 207.0 207.125000 226.0965 1 519 518 0.2814719 -1.2675335 5.1805400
rate_vermont 55 897 255.88183 157.1565468 260.0 252.948540 200.1510 1 546 545 0.0853192 -1.2140226 5.2473044
rate_washington 56 978 224.57669 152.0596727 232.5 221.579082 198.6684 1 503 502 0.0503193 -1.3229952 4.8623322
rate_wisconsin 57 960 237.23438 165.4230721 241.5 233.173177 232.0269 1 525 524 0.1033020 -1.4118359 5.3390067
rate_west_virginia 58 946 291.24419 177.2578685 268.5 287.788918 202.3749 1 630 629 0.1937622 -1.1113010 5.7631504
rate_wyoming 59 908 268.28084 153.7112924 259.0 268.269231 192.7380 1 549 548 0.0311920 -1.1128595 5.1010884
rate_age_1_4 60 253 15.78261 15.0984919 10.0 12.950739 10.3782 1 58 57 1.4317398 1.0507203 0.9492341
rate_age_5_14 61 298 11.78188 12.4868715 5.0 9.820833 5.9304 1 45 44 1.1759284 0.0574752 0.7233450
rate_age_15_24 62 403 28.58561 33.6984652 7.0 23.034056 7.4130 1 118 117 1.0885604 -0.1522306 1.6786401
rate_age_25_34 63 417 61.67866 57.7188756 44.0 56.635821 57.8214 1 172 171 0.5083953 -1.2591416 2.8265055
rate_age_35_44 64 418 73.92584 58.2706556 65.0 69.410714 75.6126 1 197 196 0.4672854 -1.0635405 2.8501109
rate_age_45_54 65 464 104.49138 75.1521705 105.5 101.741935 100.8168 1 248 247 0.1614437 -1.2705677 3.4888519
rate_age_55_64 66 464 135.71767 75.9550000 136.0 134.669355 87.4734 1 285 284 0.0283987 -0.9529242 3.5261224
rate_65_74 67 486 145.55144 88.7737796 130.5 142.379487 98.5929 1 322 321 0.3168437 -0.9671573 4.0268604
rate_age_75_84 68 486 187.80041 117.2025794 187.5 186.658974 147.5187 1 398 397 0.0619100 -1.2117752 5.3164170
rate_age_85_plus 69 486 202.65226 126.2985845 201.5 202.305128 163.0860 1 423 422 -0.0031828 -1.2238459 5.7290201 
head(laws_data)
## # A tibble: 6 × 22
##   `Law ID` State  `State Postal Abbreviation` `FIPS Code` `Law Class (num)`
##   <chr>    <chr>  <chr>                       <chr>       <chr>            
## 1 AK1002   Alaska AK                          02          2                
## 2 AK1003   Alaska AK                          02          2                
## 3 AK1004   Alaska AK                          02          2                
## 4 AK1005   Alaska AK                          02          3                
## 5 AK1006   Alaska AK                          02          3                
## 6 AK1009   Alaska AK                          02          7                
## # ℹ 17 more variables: `Law Class` <chr>, `Law Class Subtype` <chr>,
## #   `Handguns or Long Guns` <chr>, Effect <chr>, `Type of Change` <chr>,
## #   `Effective Date Note` <chr>, `Effective Date Year` <dbl>,
## #   `Effective Date Month` <dbl>, `Effective Date Day` <dbl>,
## #   `Supersession Date Year` <dbl>, `Supersession Date Month` <dbl>,
## #   `Supersession Date Day` <dbl>, `Age for Minimum Age Laws` <dbl>,
## #   `Length of Waiting Period (days, handguns)` <chr>, …
sum(apply(sapply(c('firearm', 'gun', 'shoot', 'shot'), grepl, death_data$cause_of_death, ignore.case = TRUE), 1, any))
## [1] 48
firearm_data <- death_data %>% filter(cause_of_death == 'Firearm-related injury')

The initial deaths data contains more than just data regarding firearm deaths. We can filter this by seeking out records that reference guns or similar terms.

There is data regarding suppressed laws. A suppressed law appears to be one that is no longer active, often because of a newer law succeeding it. We will want to reduce this to the latest active set of firearms laws for each state.

active_laws_data <- laws_data %>% filter(is.na(`Supersession Date Year`))
active_laws_data$State <- tolower(gsub(' ', '_', active_laws_data$State))
total_laws_data <- active_laws_data %>% count(State)
total_laws_data %>% summary()
##     State                 n        
##  Length:51          Min.   :11.00  
##  Class :character   1st Qu.:18.00  
##  Mode  :character   Median :21.00  
##                     Mean   :26.18  
##                     3rd Qu.:32.00  
##                     Max.   :59.00
sd(total_laws_data$n)
## [1] 11.90581

The amount of gun laws per state varies from 11 to 59. Since we are retroactively building a Likert scale instead of starting with a survey, we have choices to make regarding our split. The distribution isn’t normal and is right skewed. In theory, a quantile based split is good because it should reflect the lower mean. However, the size of a standard deviation is a bit too large to divide the data on the lower end, so we will use small bounds to ensure all five points have data.

five_point_range <- c(
  mean(total_laws_data$n) - 1.0 * sd(total_laws_data$n),
  mean(total_laws_data$n) - 0.5 * sd(total_laws_data$n),
  mean(total_laws_data$n) + 0.5 * sd(total_laws_data$n),
  mean(total_laws_data$n) + 1.0 * sd(total_laws_data$n)
)

five_point_conv <- function(value) {
  score <- 1
  for (point in five_point_range) {
    if (value < point) {
      return(score)
    }
    score <- score + 1
  }
  return(score)
}

total_laws_data$likert_num <- sapply(total_laws_data$n, five_point_conv)
total_laws_data %>% count(likert_num)
## # A tibble: 5 × 2
##   likert_num     n
##        <dbl> <int>
## 1          1     4
## 2          2    21
## 3          3    13
## 4          4     2
## 5          5    11
strictest <- total_laws_data %>% filter(likert_num == 5) %>% select(State)
laxest <- total_laws_data %>% filter(likert_num == 1) %>% select(State)

print(strictest)
## # A tibble: 11 × 1
##    State               
##    <chr>               
##  1 california          
##  2 colorado            
##  3 connecticut         
##  4 district_of_columbia
##  5 hawaii              
##  6 illinois            
##  7 maryland            
##  8 massachusetts       
##  9 new_jersey          
## 10 new_york            
## 11 washington
print(laxest)
## # A tibble: 4 × 1
##   State       
##   <chr>       
## 1 kansas      
## 2 kentucky    
## 3 montana     
## 4 south_dakota

The states are not evenly distributed across each Likert bin, but that is acceptable because these distributions at least reflect the actual data spread across each strictness level.

We will prepare the data to only retain scaled death total rates that exist.

firearm_reduced <- firearm_data %>% select(1:2, 4, 9:59) %>% 
  filter(time_period == '3-month period' & rate_type == 'Age-adjusted') %>% 
  select(-c(time_period, rate_type))
firearm_wide <- firearm_reduced %>% pivot_longer(
  cols = 2:52,
  names_to = 'state',
  values_to = 'rate'
) %>%
  mutate(state = str_replace_all(state, 'rate_', '')) %>% 
  separate(year_and_quarter, into = c('year', 'quarter'), sep = ' ') %>%
  mutate(
    year = as.numeric(year),
    rate = as.numeric(rate)
  ) %>% 
  filter(!is.na(rate)) %>%
  rename(State = state)

firearm_wide %>% 
  group_by(year, quarter) %>% 
  summarise(count = n())
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.
## # A tibble: 11 × 3
## # Groups:   year [3]
##     year quarter count
##    <dbl> <chr>   <int>
##  1  2022 Q1         51
##  2  2022 Q2         51
##  3  2022 Q3         51
##  4  2022 Q4         51
##  5  2023 Q1         51
##  6  2023 Q2         51
##  7  2023 Q3         51
##  8  2023 Q4         51
##  9  2024 Q1         51
## 10  2024 Q2         51
## 11  2024 Q3         51
firearm_state_avg <- firearm_wide %>%
  group_by(State) %>%
  summarise(average_rate = round(mean(rate), digits = 2))

We will include District of Columbia as our honorary 51st state to keep all our data for now. It is within the continental US, so it fits within our parameters. We will revisit this decision if the results imply it’s a problematic point. All states have complete data within this 2022-2024 span, so we do not need to worry about imputation.

restrictive_laws_full <- active_laws_data %>% filter(Effect == 'Restrictive')
restrictive_laws <- restrictive_laws_full %>% count(State)
five_point_range <- c(
  mean(restrictive_laws$n) - 1.0 * sd(restrictive_laws$n),
  mean(restrictive_laws$n) - 0.5 * sd(restrictive_laws$n),
  mean(restrictive_laws$n) + 0.5 * sd(restrictive_laws$n),
  mean(restrictive_laws$n) + 1.0 * sd(restrictive_laws$n)
)

restrictive_laws$likert_num <- sapply(restrictive_laws$n, five_point_conv)
restrictive_laws %>% count(likert_num)
## # A tibble: 5 × 2
##   likert_num     n
##        <dbl> <int>
## 1          1     5
## 2          2    17
## 3          3    17
## 4          4     2
## 5          5    10
strictest_res <- total_laws_data %>% filter(likert_num == 5) %>% select(State)
laxest_res <- total_laws_data %>% filter(likert_num == 1) %>% select(State)

print(strictest_res)
## # A tibble: 11 × 1
##    State               
##    <chr>               
##  1 california          
##  2 colorado            
##  3 connecticut         
##  4 district_of_columbia
##  5 hawaii              
##  6 illinois            
##  7 maryland            
##  8 massachusetts       
##  9 new_jersey          
## 10 new_york            
## 11 washington
print(laxest_res)
## # A tibble: 4 × 1
##   State       
##   <chr>       
## 1 kansas      
## 2 kentucky    
## 3 montana     
## 4 south_dakota

Laws are divided between restrictive and permissive. While restrictive laws are more associated with gun control, it also makes sense that states that provide more laws for both restrictions and permissions are likely to provide laws that control gun violence better. Our focus will be on laws as a whole. We may reference the restrictive laws data if results are unusual.

Analysis

total_plot <- total_laws_data %>% 
  mutate(
    highlight = case_when(
      State %in% strictest$State ~ 'Very Strict',
      State %in% laxest$State ~ 'Very Lax',
      TRUE ~ 'Normal'
      )
    ) %>%
  ggplot(aes(x = n, y = fct_reorder(State, n), fill = highlight)) +
  geom_col() +
  labs(x = 'Total Gun Laws', y = 'State', title = 'Total Gun Laws Per State', fill = 'Law Strictness Scale') + 
  scale_fill_manual(
      values = c('Very Strict' = 'darkblue', 'Very Lax' = 'lightblue', 'Normal' = 'gray')
    )

firearm_plot <- firearm_state_avg %>% 
  mutate(
    highlight = case_when(
      State %in% strictest$State ~ 'Very Strict',
      State %in% laxest$State ~ 'Very Lax',
      TRUE ~ 'Normal'
      )
    ) %>%
  ggplot(aes(x = average_rate, y = fct_reorder(State, average_rate), fill = highlight)) +
  geom_col() +
  labs(x = 'Deaths Per 100,000 People', y = 'State', title = 'Average Death Rate From Firearms Per State', 
      fill = 'Law Strictness Scale',
      caption = 'States with more gun laws generally had lower firearm deaths. District of Columbia, notably not a state, was an exception.') + 
  scale_fill_manual(
      values = c('Very Strict' = 'darkblue', 'Very Lax' = 'lightblue', 'Normal' = 'gray')
    )

combined_plots <- total_plot + firearm_plot + plot_annotation(title = 'Firearm Death Rate By Gun Law Strictness')

combined_plots

Comparing the states that we marked as most and least strict in terms of total gun laws, we can compare their distinct rankings in the deaths per 100,000 side. The states with the fewest laws ranged from high death rates to average. So far, it appears that law strictness has a clear impact for the strictest states with lesser clear results for the laxest states.

The states with more laws had most of the lowest death figures with notable exceptions of Colorado and District of Columbia. As the latter isn’t a state, we were unsure if it would be suited for this analysis.

Next, let’s determine if there appears to be a trend in the complete set of states.

merged_df <- merge(total_laws_data, firearm_state_avg, by = 'State')

merged_df %>% 
  ggplot(aes(x = n, y = average_rate)) +
  geom_point() +
  geom_smooth() +
  geom_text(data = merged_df %>% filter(State %in% c('district_of_columbia', 'california', 'montana')), aes(label = State), 
            nudge_y = 1.5, 
            color = 'blue') +
  labs(x = 'Total Active Gun Laws', y = 'Deaths Per 100,000 People', title = 'Law Strictness vs. Firearm Deaths')
## `geom_smooth()` using method = 'loess' and formula = 'y ~ x'

cor.test(merged_df$n, merged_df$average_rate)
## 
##  Pearson's product-moment correlation
## 
## data:  merged_df$n and merged_df$average_rate
## t = -5.0945, df = 49, p-value = 5.59e-06
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  -0.7434631 -0.3734147
## sample estimates:
##        cor 
## -0.5884434

States with stricter gun laws tend to have a smaller share of firearm related deaths compared to other causes. This is noticeable in the average downward trend of the fitting line. The -0.588 correlation between deaths and total gun laws is very strong. Key points include our strictest state California, laxest state Montana, and our exception and honorary state District of Columbia. We will reexamine the data without District of Columbia because it is clearly an outlier. As the location with many of the nation’s prominent leaders, it may have a skewed amount of firearms related deaths.

Conclusion

merged_df %>% mutate(State = fct_reorder(State, n)) %>% 
  filter(!State == 'district_of_columbia') %>% 
  ggplot(aes(x = likert_num, y = State, fill = average_rate)) +
  geom_tile() +
  scale_fill_distiller(palette = 'Reds', direction = 1) +
  scale_x_continuous(
    breaks = c(1, 2, 3, 4, 5),
    labels = c('Very Lax', 'Lax', 'Neutral', 'Strict', 'Very Strict')) +
  labs(x = 'Total Laws Likert Scale', 
       fill = 'Deaths Per 100,000',
       title = 'Firearm Deaths Drop Off When Gun Laws are Stricter than Normal')

Total firearm gun laws work when trying to reduce deaths from firearms. Even without delineating between permissive and restrictive laws, there is a notable difference between states that are lax or very lax and all states with higher amounts of laws. This information is strictly relevant for states as District of Columbia did not fall into this same pattern.