This analysis was done in order to better understand gun violence trends in the US. Given the fact that shootings are such a persistent problem in the US and countless people are killed as a result of this epidemic, I wanted to take this opportunity to explore what factor may be correlated with greater violence. Factors such as gender, age, location, how the gun was obtained are all things that may increase the likelihood of a shooting taking place and if that shooting also takes lives.

library(dplyr)
## 
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
library(ggplot2)
library(tidyverse)
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ forcats   1.0.0     ✔ stringr   1.5.1
## ✔ lubridate 1.9.3     ✔ tibble    3.2.1
## ✔ purrr     1.0.2     ✔ tidyr     1.3.1
## ✔ readr     2.1.5
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(purrr)
library(maps)
## 
## Attaching package: 'maps'
## 
## The following object is masked from 'package:purrr':
## 
##     map
library(leaflet)
library(RColorBrewer)

Research Question 1: Is there a relationship between the timing of shootings and the proximity to an election?

# CHANGE DATA TYPE & AGGREGATE DATA:
gun_data$date <- as.Date(gun_data$date)

incident_counts <- gun_data %>%
  group_by(date) %>%
  summarise(count = n())
# CREATE DATE RANGE:
start_date <- as.Date("2016-07-31")
end_date <- as.Date("2017-04-30")

election_inaguration_markers <- as.Date(c("2016-11-08", "2017-01-20"))
# dates are sourced from: https://historyinpieces.com/research/presidential-inauguration-dates
# VISUALIZE DATA: 
ggplot(data = incident_counts) + 
  geom_line(aes(x = date, y = count)) +
  # Vertical lines to mark election and inaguration
  lapply(election_inaguration_markers, function(marker_date) {
    geom_vline(aes(xintercept = as.numeric(marker_date)), 
               color = "red", linetype = "dashed", linewidth = 1)
  }) +
  labs(title = "Number of Shootings Throughout the Year",
       x = "Date",
       y = "Number of Shootings") +
  theme_minimal() +
  scale_x_date(limits = c(start_date, end_date))
## Warning: Removed 1452 rows containing missing values or values outside the scale range
## (`geom_line()`).

This graph visualizes the number of shootings that occurred 100 days before and 100 days following the 2016 election. Given the fact that the 2016 was rather politically charged, this period made for an interesting time to particularly analyze. While the number of shootings remained stagnant for a majority of this window of time, there is a noticeable shooting spike in early January 2017. While at a first glance one may attribute this spike to political tension following the 2016 election, this spike is likely due to New Year’s Eve/Day celebrations usually resulting in an uptick in shootings (people firing guns to celebrate).

Research Question 2: How do shooter characteristics (e.g. age, gender) vary depending on the location?

# FUNCTIONS:
extract_multiple_suspect_info <- function(age, gender, type) {
  # Split the strings by "||"
  age_list <- strsplit(as.character(age), "\\|\\|")[[1]]
  gender_list <- strsplit(as.character(gender), "\\|\\|")[[1]]
  type_list <- strsplit(as.character(type), "\\|\\|")[[1]]
  
  # Identify indices where the type is "Subject-Suspect"
  suspect_indices <- which(grepl("Subject-Suspect", type_list))
  
  # Extract corresponding ages and genders for suspects
  if (length(suspect_indices) > 0) {
    suspect_ages <- paste(sapply(suspect_indices, function(idx) strsplit(age_list[idx], "::")[[1]][2]), collapse = ", ")
    suspect_genders <- paste(sapply(suspect_indices, function(idx) strsplit(gender_list[idx], "::")[[1]][2]), collapse = ", ")
    suspect_types <- paste(sapply(suspect_indices, function(idx) strsplit(type_list[idx], "::")[[1]][2]), collapse = ", ")
    
    return(list(age = suspect_ages, gender = suspect_genders, type = suspect_types))
  } else {
    return(list(age = NA, gender = NA, type = NA))
  }
}
# APPLY FUNCTIONS: 
suspect_info <- pmap_dfr(
  list(gun_data$participant_age, gun_data$participant_gender, gun_data$participant_type),
  extract_multiple_suspect_info
)

# Add extracted info as new columns
gun_data <- gun_data %>%
  mutate(
    suspect_age = suspect_info$age,
    suspect_gender = suspect_info$gender,
    suspect_type = suspect_info$type
  )

# Calculate number of shootings per state
state_counts <- gun_data %>%
  filter(!is.na(state)) %>%
  group_by(state) %>%
  summarise(incident_id = n()) %>%
  top_n(10, incident_id)
# ESTABLISH TOP 10 STATES (by frequency of shootings):
top_locations <- gun_data %>%
  filter(state %in% state_counts$state) %>%
  group_by(state) %>%
  summarise(
    incident_id = n(),
    most_frequent_gender = names(sort(table(suspect_gender), decreasing = TRUE)[1]),
    average_age = mean(as.numeric(unlist(strsplit(suspect_age, ", "))), na.rm = TRUE)
  )
## Warning: There were 10 warnings in `summarise()`.
## The first warning was:
## ℹ In argument: `average_age = mean(as.numeric(unlist(strsplit(suspect_age, ",
##   "))), na.rm = TRUE)`.
## ℹ In group 1: `state = "California"`.
## Caused by warning in `mean()`:
## ! NAs introduced by coercion
## ℹ Run `dplyr::last_dplyr_warnings()` to see the 9 remaining warnings.
state_coords <- data.frame(
  state = c("California", "Florida", "Georgia", "Illinois", "Louisiana",
            "New York", "North Carolina", "Ohio", "Pennsylvania", "Texas"),
  lat = c(36.7783, 27.9944, 32.1656, 40.6331, 30.9843, 
          40.7128, 35.7596, 40.4173, 41.2033, 31.9686),
  long = c(-119.4179, -81.7603, -82.9001, -89.3985, -91.9623, 
           -74.0060, -79.0193, -82.9071, -77.1945, -99.9018)
)

# Merge the state coordinates with the top_locations data
top_locations <- merge(top_locations, state_coords, by = "state")
# VISUALIZE DATA: 
leaflet(top_locations) %>%
  addTiles() %>%
  addCircleMarkers(
    lng = ~long, lat = ~lat,
    radius = ~sqrt(incident_id) / 100,
    color = ~colorNumeric(palette = "Spectral", domain = top_locations$incident_id, reverse = TRUE)(incident_id),
    fillOpacity = 1,
    label = ~lapply(paste0(
      "<strong>", state, "</strong><br/>",
      "Shootings: ", incident_id, "<br/>",
      "Most Frequent Gender: ", most_frequent_gender, "<br/>",
      "Average Age: ", round(average_age, 1)
    ), htmltools::HTML),
    labelOptions = labelOptions(
      style = list("font-weight" = "normal", padding = "3px 8px"),
      textsize = "15px",
      direction = "auto"
    )
  ) %>%
  addLegend(
    "bottomright",
    pal = colorNumeric(palette = "Spectral", domain = top_locations$incident_id, reverse = TRUE),
    values = ~incident_id,
    title = "Number of Shootings",
    opacity = 1
  ) %>%
  addControl(
    html = "Top 10 States with the Most Shootings",
    position = "topleft"
  )

Throughout the country, gun violence remains an issue. The 10 states with the greatest number of shootings are: California, Texas, Florida, New York, Pennsylvania, Illinois, Ohio, Georgia, and North Carolina, and Louisiana. The first 9 also being the 9 most populous states. Furthermore, all the shooters were male and fell between the ages of 27 and 30. It is worth noting that while the first 9 states having the largest number of shootings make for unremarkable correlation, Louisiana making the top 10 despite having the 25th largest US population may reveal a deeper gun violence/shooting issue in the state.

Research Question 3: Is there a correlation to a gun being stolen and there being a greater number of people killed in a shooting?

# SUBSET DATA: 
gun_data_stolen <- gun_data %>%
  subset(gun_data$n_guns_involved == 1)

# CREATE & APPLY FUNCTION: 
extract_stolen_status <- function(gun_stolen_column) {
  # Split the string by "::" and extract the status
  status <- strsplit(gun_stolen_column, "::")[[1]][2]
  return(status)
}

# Apply function to gun_stolen column
gun_data_stolen$stolen_status <- sapply(gun_data_stolen$gun_stolen, extract_stolen_status)

gun_data_stolen <- gun_data_stolen[!is.na(gun_data_stolen$stolen_status), ]

gun_data_stolen <- gun_data_stolen %>%
  filter(gun_data_stolen$stolen_status != "Unknown")
# SUMMARIZE & VISUALIZE DATA: 

# Total number of incidents
total_incidents <- nrow(gun_data_stolen)

# Summarize data with additional calculation for shootings per 100 incidents
summary_data <- gun_data_stolen %>%
  group_by(stolen_status) %>%
  summarise(
    total_killed = sum(n_killed, na.rm = TRUE),
    count = n(),
    killed_per_100_shootings = (sum(n_killed, na.rm = TRUE) / n()) * 100
  )


# Create a bar chart to visualize the relationship
ggplot(summary_data, aes(x = stolen_status, y = killed_per_100_shootings, fill = stolen_status)) +
  geom_bar(stat = "identity", width = 0.7) +
  geom_text(aes(label = round(killed_per_100_shootings, 1)), vjust = -0.5) +
  labs(title = "Number of People Killed (per 100 shootings) vs. Gun Stolen Status",
       x = "Gun Stolen Status",
       y = "Number of People Killed (per 100 shootings)") +
  theme_minimal() +
  scale_fill_manual(values = c("Not-stolen" = "lightgreen", "Stolen" = "red"))

Interestingly, the trend appears to show that guns that are Not-stolen result in more deaths per 100 shootings than guns that are Stolen. The data was filtered to exclude shootings where whether or not the gun was stolen was Unknown. The calculations for the number of people killed was done per 100 shootings to help standardize the results. This may hint to an underlying issue of gun laws being too loose leading to a greater number of shootings as opposed to stolen or illegal guns.

Research Question 4: Are shootings more likely to occur in certain congressional districts?

# SUBSET & MUTATE DATA: 
gun_data_pa <- gun_data %>%
  subset(gun_data$state == "Pennsylvania" & 
           gun_data$congressional_district != "NA")

gun_data_pa <- gun_data_pa %>%
  mutate(district_label = paste("PA-", congressional_district, sep = ""),
         political_leaning = ifelse(congressional_district %in% c(12, 5, 3, 2, 6, 4),
                                    "Democratic",
                                    ifelse(congressional_district %in% c(8, 9, 10, 11, 13, 14, 15, 16, 18),
                                           "Republican",
                                           "Neutral")))
# VISUALIZE DATA: 
gun_data_pa$district_label <- factor(gun_data_pa$district_label, levels = c("PA-1", "PA-2", "PA-3", "PA-4", "PA-5", "PA-6", "PA-7", "PA-8", "PA-9", "PA-10", "PA-11", "PA-12", "PA-13", "PA-14", "PA-15", "PA-16", "PA-17", "PA-18"))

ggplot(gun_data_pa, aes(x = district_label, y = incident_id, fill = political_leaning)) +
  geom_bar(stat = "summary", fun = "mean") +
  labs(title = "Average Number of Shootings per PA Congressional District",
       x = "Congressional District",
       y = "Average Number of Shootings") +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
  scale_y_continuous(labels = function(x) format(x, big.mark = ",", scientific = FALSE)) +
  scale_fill_manual(values = c("Democratic" = "blue", "Neutral" = "purple", "Republican" = "red"))

This final visualization displays the average number of shootings in each Pennsylvania congressional district. Given that Pennsylvania is a swing state, the congressional districts would provide a good variety of political makeups. While the political leaning does not appear to have a significant influence on the average rate of shootings, there are a few Democratic districts PA-3 and PA-5 that have a slightly higher rate. This may be due to those districts being in the Philadelphia metropolitan area.