Link to the Final Shiny App.
The Washington Post has recorded fatal police shootings since 2015. They have published and now host a dataset containing information about those fatally shot (since 2015) and the situations leading up to the shootings. The links above will lead you to their dataset and The Washington Post’s nicely-done dashboard.
Using The Washington Post’s dataset, I wanted to make a simple Shiny App using R that helps visualize some of the fatal police shootings since 2015.
There are many, many different ways of visualizing the data, but I have chosen to keep it simple by visualizing each fatality as a red circle.
The first version of the app is simple from a user and developer’s point of view. Users can adjust the date range to their liking, as well as filter the shootings by state or region. In the next version, there will be more graphs displayed and the map will share a color palette with these graphs. Once I started working on the color palettes, I decided to upload this simpler version just as a placeholder for the more informative app still being made.
In this version, the global.R file reads/merges the data from The Washington Post with the states/regions from the ‘datasets’ package. The ui.R file contains the date and state/region selectors, as well as calls the server.R file to render the map and graph, after filtering the dataset given the date/state filters.
# ui.R for Visualizing Police Shootings
# Simeon Paynter
# last updated: 6-10-2021
ui <- fluidPage(
theme = shinytheme("yeti"),
titlePanel(title="Fatal Police Shootings (since 1/1/2015)", windowTitle="Fatal Police Shootings"),
h6("Data source: ", a(href = "https://www.washingtonpost.com/graphics/investigations/police-shootings-database/", "The Washington Post")),
sidebarLayout(
# Sidebar's position relative to the main panel
position = "right",
#sidebar
sidebarPanel(
#--------------#
radioButtons(inputId = "Date_Picker",
label = strong("Dates Displayed:"),
choices = c("All" = "All",
"Recent Amount of Time" = "Past_time",
"Specific Year" = "Specif_Yr",
"Custom Date Range" = "Custom_Dates"),
selected = "All"),
# depending on how user wants to select date
conditionalPanel(condition = "input.Date_Picker == 'Past_time'",
selectInput(inputId = "Past_x_time",
label = strong("Amount of Time to display:"),
choices = c("Past Month" = "Mo1",
"Past 3 Months" = "Mo3",
"Past 6 Months" = "Mo6",
"Past Year" = "Yr1"),
selected = "Mo1")),
conditionalPanel(condition = "input.Date_Picker == 'Specif_Yr'",
selectInput(inputId = "Spec_Yr",
label = strong("Select a Year:"),
choices = c(year:2015),
selected = year)),
conditionalPanel(condition = "input.Date_Picker == 'Custom_Dates'",
dateRangeInput(inputId = "Date_Range",
label = strong("Enter Specific Date Range: "),
format = "M d, yyyy",
start = "2015-01-01",
end = today,
min = "2015-01-01",
max = today
)),
#---------------#
radioButtons(inputId = "State_Region_filter",
label = strong("Filter by Region or State:"),
choices = c("All U.S." = "All",
"State(s)" = "State",
"Region(s)" = "Region"),
selected = "All"),
# depending if user wants to filter the data for a specific state or region
conditionalPanel(condition = "input.State_Region_filter == 'State'",
selectInput(inputId = "State_Selector",
label = strong("Select State(s) to filter by: "),
choices = c(state.abb),
selected = "MN",
multiple = TRUE),
h6("* Use backspace to remove state(s).")),
conditionalPanel(condition = "input.State_Region_filter == 'Region'",
selectInput(inputId = "Region_Selector",
label = strong("Select Region(s) to filter by: "),
choices = c("Pacific",
"Mountain",
"West North Central",
"West South Central",
"East North Central",
"East South Central",
"Middle Atlantic",
"New England",
"South Atlantic"),
selected = "Pacific",
multiple = TRUE),
h6("* Use backspace to remove region(s)."))
),
# main
mainPanel(
leafletOutput(outputId = "map"),
plotOutput(outputId = "graph")
)
),
h6("App created By Simeon Paynter. Code can be found ", a(href = "https://github.com/stpaynter/Visualizing-Police-Shootings", "here"))
)# server.R for Visualizing Police Shootings
# Simeon Paynter
# last updated: 6-10-2021
server <- function(input, output, session) {
# Filter by date range
filtered_by_date <- reactive({
# All years
if(input$Date_Picker == "All"){
return(merged_df)
# Past week, Past month, Past year, ...
}else if(input$Date_Picker == "Past_time"){
# from global.R, today is the last day available.
end = today
# using 'lubridate' package for easy subtraction of time
if(input$Past_x_time == "Mo1"){
start = today - months(1)
}else if(input$Past_x_time == "Mo3"){
start = today - months(3)
}else if(input$Past_x_time == "Mo6"){
start = today - months(6)
}else if(input$Past_x_time == "Yr1"){
start = today - years(1)
}else{
start = "2015-01-01"
}
temp_df <- merged_df %>% filter(date >= start, date <= end)
return(temp_df)
# Select a specific year
}else if(input$Date_Picker == "Specif_Yr"){
temp_df <- merged_df %>% filter(format(date, '%Y') == input$Spec_Yr)
return(temp_df)
# Fully-custom date range
}else{
start = input$Date_Range[1]
end = input$Date_Range[2]
temp_df <- merged_df %>% filter(date >= start, date <= end)
return(temp_df)
}
})
# State/ Region Selection
filtered_by_state_region <- reactive({
filtered_df <- filtered_by_date()
if(input$State_Region_filter == "All"){
return(filtered_df)
}else if(input$State_Region_filter == "State"){
if (length(input$State_Selector) < 1){
temp_df <- c()
return(temp_df)
}else{
temp_df <- filtered_df %>% filter(state %in% input$State_Selector)
return(temp_df)
}
}else if(input$State_Region_filter == "Region"){
if(length(input$Region_Selector) < 1){
temp_df <- c()
return(temp_df)
}else{
temp_df <- filtered_df %>% filter(region %in% input$Region_Selector)
return(temp_df)
}
}
})
# Create Map
output$map <- renderLeaflet({
df <- filtered_by_state_region()
if(!is.null(df)){
name <- ifelse(is.na(df$name), "Name Unknown", df$name)
age <- ifelse(is.na(df$age), "Age Unknown", df$age)
gender <- ifelse(is.na(df$gender), "Unknown", df$gender)
race <- ifelse(is.na(df$race), "Unknown", df$race)
labels <- paste0(name,
"<br>Age: ", age,
"<br>City: ", df$city, ", ", df$state,
"<br>Gender: ", gender,
"<br>Race: ", race,
"<br>Signs of Mental Illness: ", df$signs_of_mental_illness,
"<br>Armed: ", df$armed,
"<br>Date of Death: ", format(df$date, "%B %d, %Y")
)
leaflet(df) %>%
addProviderTiles("CartoDB.Positron") %>%
addCircleMarkers(lng = ~longitude,
lat = ~latitude,
radius = 5,
fillOpacity = 0.25,
color = "red",
stroke = FALSE,
label = lapply(labels, HTML))
}else{ #if state/region is blank, a world map is displayed.
leaflet(df) %>% addProviderTiles("CartoDB.Positron")
}
})
# Create graph
output$graph <- renderPlot({
df <- filtered_by_state_region()
if(!is.null(df)){
min_date <- min(df$date) %>% format("%B %d, %Y")
max_date <- max(df$date) %>% format("%B %d, %Y")
df1 <- df %>% group_by(state, city) %>% summarise(count = n()) %>% arrange(desc(count)) %>% head(10)
ggplot(df1, aes(x=reorder(city, count), y = count)) +
geom_bar(stat="identity", width=0.5, fill="red", alpha=0.5) +
labs(title = paste0("Cities Where Shooting Occurred"),
subtitle = paste(min_date, "to", max_date),
x = "City",
y = "# of Shootings") +
theme(plot.title = element_text(hjust=0.5),
plot.subtitle = element_text(hjust = 0.5)) +
coord_flip()
}
})
}
# global.R for Visualizing Police Shootings
# Simeon Paynter
# last updated: 6-10-2021
# Libraries used
library(shiny)
library(shinythemes)
library(tidyverse)
library(lubridate)
library(leaflet)
# Today's Date, Year
today = Sys.Date()
year = format(today, '%Y')
# Read in data from Washington Post's GitHub, specify variable types
WP_data <- read_csv("https://github.com/washingtonpost/data-police-shootings/releases/download/v0.1/fatal-police-shootings-data.csv",
col_types = cols(
.default = col_character(),
id = col_skip(),
date = col_date(),
age = col_integer(),
signs_of_mental_illness = col_logical(),
body_camera = col_logical(),
longitude = col_double(),
latitude = col_double(),
is_geocoding_exact = col_skip()
))
# Write-out gender and race variables
WP_data$gender <- sub("F", "Female", WP_data$gender)
WP_data$gender <- sub("M", "Male", WP_data$gender)
WP_data$race <- sub("A", "Asian", WP_data$race)
WP_data$race <- sub("H", "Hispanic", WP_data$race)
WP_data$race <- sub("N", "Native American", WP_data$race)
WP_data$race <- sub("O", "Other", WP_data$race)
WP_data$race <- sub("B", "Black (non-Hispanic)", WP_data$race)
WP_data$race <- sub("W", "White (non-Hispanic)", WP_data$race)
# Combine with state name from the 'datasets' package
states <- data.frame(state_name = state.name,
state_abb = state.abb,
region = paste(state.division))
merged_df <- inner_join(WP_data, states, by = c("state" = "state_abb"))