Two of these visualizations should be Shiny Apps with meaningful interactivity, at least one should be an animation, and at least one should be made using Plotly or Tableau
choropleth_data <- read.csv("cleaned_gun_policy_data.csv")
state_abbr <- data.frame(
Residence.State = state.name,
code = state.abb
)
choropleth_data <- choropleth_data %>%
left_join(state_abbr, by = "Residence.State")
choropleth_data$hover <- with(choropleth_data, paste0(
Residence.State, "<br>",
"Basic Gun Laws: ", NumBasicLaws, "<br>",
"Population:",Population,"<br>"
))
l <- list(color = toRGB("black"), width = 1)
g <- list(
scope = 'usa',
projection = list(type = 'albers usa'),
showlakes = TRUE,
lakecolor = toRGB('white')
)
fig <- plot_geo(choropleth_data, locationmode = 'USA-states')
fig <- fig %>%
add_trace(
z = ~Crude.Rate, text = ~hover, locations = ~code,
color = ~Crude.Rate, colors = 'Reds',
marker = list(line = l)
) %>%
colorbar(title = "Death Rate") %>%
layout(
title = list(
text = "Firearm Mortality Rate by State (2018–2025)<br><sub>Hover to View Policy Information and Population</sub>",
x = 0.5
),
geo = g
)
fig
gun_policy_data<-read.csv("cleaned_gun_policy_data.csv")
model <- lm(Crude.Rate ~ Gun_Law_Rating, data = gun_policy_data)
line_data <- data.frame(Gun_Law_Rating = seq(min(gun_policy_data$Gun_Law_Rating),
max(gun_policy_data$Gun_Law_Rating),
length.out = 100))
line_data$Crude.Rate <- predict(model, newdata = line_data)
final_iteration <- plot_ly()
final_iteration <- final_iteration %>%
add_trace(data = gun_policy_data,
x = ~Gun_Law_Rating,
y = ~Crude.Rate,
type = "scatter",
mode = "markers",
color = ~factor(NumBasicLaws),
colors = viridis(n = length(unique(gun_policy_data$NumBasicLaws)), option = "D"),
text = ~paste("State:", Residence.State,
"<br>Gun Law Rating:", Gun_Law_Rating,
"<br>Death Rate:", Crude.Rate,
"<br>Basic Policies:", NumBasicLaws),
hoverinfo = "text",
marker = list())
final_iteration <- final_iteration %>%
add_lines(data = line_data,
x = ~Gun_Law_Rating,
y = ~Crude.Rate,
line = list(color = 'black'),
name = "Linear Regression Line")
final_iteration <- final_iteration %>%
layout(title = list(text = "Crude Death Rate by State Gun Law Rating<br><sub>Colored by Number of Basic Gun Policies</sub>", x = .5),
xaxis = list(title = "Gun Law Rating (Everytown)"),
yaxis = list(title = "Crude Firearm Death Rate per 100,000 People"),
legend = list(title = list(text = "Number of Foundational Gun Laws")))
final_iteration<-final_iteration%>%
layout(
legend = list(
orientation = "v",
x = 1.02,
xanchor = "left",
y = 0.5,
yanchor = "middle"
)
)
final_iteration
This interactive tool lets you compare firearm death rates across racial groups and states from 1999 to 2023.