For this assignment, I decided to look at fatal encounters by gunshot in ZTCA regions of the city of Los Angeles, California. Gun violence, especially as it pertains to police encounters, is an omnipresent issue in Los Angeles, and through this analysis I aimed to discover what seasons gunshot deaths occured in, as well as relationship between median household income and gunshot incidents in Los Angeles.
# Load required packages
library(tidyverse)
library(sf)
library(tmap)
library(leaflet)
library(tidycensus)
library(dplyr)
library(tigris)
# Preparing data
fatalities <- read_csv("FATAL ENCOUNTERS DOT ORG SPREADSHEET (See Read me tab) - Form Responses.csv")
# Set Census API key
tidycensus::census_api_key(Sys.getenv("CENSUS_API_KEY"))
To perform my analysis, I downloaded ZCTA (zip code tabulation area) data from the ACS, merged it with Fatal Encounters data (from fatalencounters.org) that tracks police killings of civilians from 2001 to present day, and mapped the findings.
# Download ZTCAs with ACS data
ca_zips <- get_acs(geography = "zcta",
variables = "B01003_001", # Population variable
year = 2020,
geometry = TRUE)
## | | | 0% | | | 1% | |= | 1% | |= | 2% | |== | 2% | |== | 3% | |== | 4% | |=== | 4% | |=== | 5% | |==== | 5% | |==== | 6% | |===== | 6% | |===== | 7% | |===== | 8% | |====== | 8% | |====== | 9% | |======= | 9% | |======= | 10% | |======= | 11% | |======== | 11% | |======== | 12% | |========= | 12% | |========= | 13% | |========= | 14% | |========== | 14% | |========== | 15% | |=========== | 15% | |=========== | 16% | |============ | 16% | |============ | 17% | |============ | 18% | |============= | 18% | |============= | 19% | |============== | 19% | |============== | 20% | |============== | 21% | |=============== | 21% | |=============== | 22% | |================ | 22% | |================ | 23% | |================ | 24% | |================= | 24% | |================= | 25% | |================== | 25% | |================== | 26% | |=================== | 26% | |=================== | 27% | |=================== | 28% | |==================== | 28% | |==================== | 29% | |===================== | 29% | |===================== | 30% | |===================== | 31% | |====================== | 31% | |====================== | 32% | |======================= | 32% | |======================= | 33% | |======================= | 34% | |======================== | 34% | |======================== | 35% | |========================= | 35% | |========================= | 36% | |========================== | 36% | |========================== | 37% | |========================== | 38% | |=========================== | 38% | |=========================== | 39% | |============================ | 39% | |============================ | 40% | |============================ | 41% | |============================= | 41% | |============================= | 42% | |============================== | 42% | |============================== | 43% | |=============================== | 44% | |=============================== | 45% | |================================ | 45% | |================================ | 46% | |================================= | 47% | |================================= | 48% | |================================== | 48% | |================================== | 49% | |=================================== | 49% | |=================================== | 50% | |=================================== | 51% | |==================================== | 51% | |==================================== | 52% | |===================================== | 52% | |===================================== | 53% | |===================================== | 54% | |====================================== | 54% | |====================================== | 55% | |======================================= | 55% | |======================================= | 56% | |======================================== | 56% | |======================================== | 57% | |======================================== | 58% | |========================================= | 58% | |========================================= | 59% | |========================================== | 59% | |========================================== | 60% | |========================================== | 61% | |=========================================== | 61% | |=========================================== | 62% | |============================================ | 62% | |============================================ | 63% | |============================================ | 64% | |============================================= | 64% | |============================================= | 65% | |============================================== | 65% | |============================================== | 66% | |=============================================== | 67% | |=============================================== | 68% | |================================================ | 68% | |================================================ | 69% | |================================================= | 69% | |================================================= | 70% | |================================================= | 71% | |================================================== | 71% | |================================================== | 72% | |=================================================== | 72% | |=================================================== | 73% | |=================================================== | 74% | |==================================================== | 74% | |==================================================== | 75% | |===================================================== | 75% | |===================================================== | 76% | |====================================================== | 76% | |====================================================== | 77% | |====================================================== | 78% | |======================================================= | 78% | |======================================================= | 79% | |======================================================== | 79% | |======================================================== | 80% | |======================================================== | 81% | |========================================================= | 81% | |========================================================= | 82% | |========================================================== | 82% | |========================================================== | 83% | |========================================================== | 84% | |=========================================================== | 84% | |=========================================================== | 85% | |============================================================ | 85% | |============================================================ | 86% | |============================================================= | 86% | |============================================================= | 87% | |============================================================= | 88% | |============================================================== | 88% | |============================================================== | 89% | |=============================================================== | 89% | |=============================================================== | 90% | |=============================================================== | 91% | |================================================================ | 91% | |================================================================ | 92% | |================================================================= | 92% | |================================================================= | 93% | |================================================================= | 94% | |================================================================== | 94% | |================================================================== | 95% | |=================================================================== | 95% | |=================================================================== | 96% | |==================================================================== | 96% | |==================================================================== | 97% | |==================================================================== | 98% | |===================================================================== | 98% | |===================================================================== | 99% | |======================================================================| 99% | |======================================================================| 100%
# Remove rows with NA in Longitude or Latitude
fatal <- fatalities[!is.na(fatalities$Longitude) & !is.na(fatalities$Latitude), ]
na_count <- sum(is.na(fatal$Longitude)) + sum(is.na(fatal$Latitude))
if (na_count > 0) {
cat("Warning: Removed", na_count, "rows due to missing Longitude or Latitude values.\n")
}
# Verify that there are no more NA values
sum(is.na(fatal$Longitude))
## [1] 0
sum(is.na(fatal$Latitude))
## [1] 0
# Rename the column "Location of death (zip code)" to "GEOID"
fatal <- fatal %>%
rename("GEOID" = "Location of death (zip code)")
# Merge fatal data with the Census ZCTA data, retaining geometry
fatal_zip <- ca_zips %>%
left_join(fatal, by = c("GEOID" = "GEOID"))
# Rename the highest level of force column to "force"
fatal_zip <- fatal_zip %>%
rename(force = `Highest level of force`)
# Filter for LA ZCTAs
la_zips <- ca_zips %>%
filter(str_starts(GEOID, "900")) # Filter for ZCTAs starting with "900"
# Filter fatal dataset for LA County, ensuring geometry is preserved
fatal_la <- fatal_zip %>%
filter(GEOID %in% la_zips$GEOID) %>%
filter(force == "Gunshot") # Filter for gunshot incidents
# Create a color palette for different levels of force
force_palette <- colorFactor(palette = "RdYlBu", domain = fatal_la$force)
# Create the Leaflet map
leaflet(data = fatal_la) %>%
addProviderTiles("CartoDB.DarkMatter") %>% # Use dark basemap
# Add points for each incident in LA County with outlines
addCircleMarkers(
lng = ~st_coordinates(geometry)[, 1],
lat = ~st_coordinates(geometry)[, 2],
fillColor = ~force_palette(force),
radius = 5,
stroke = TRUE,
weight = 1,
color = "black",
fillOpacity = 0.7,
popup = ~paste("ZIP Code:", GEOID, "<br>", "Force Level:", force)
) %>%
addLegend("bottomright",
pal = force_palette,
values = ~force,
title = "Level of Force",
opacity = 1)
With the following exercise, I aimed to answer the question: “What time of year do police killings by gunshot occur in?” I created a column for seasons, separating the data based on time of year, and mapped the results.
# Rename date column
fatal_la <- fatal_la %>%
rename(time = `Date of injury resulting in death (month/day/year)`)
# Create new column for season based on time
fatal_la <- fatal_la %>%
mutate(month = as.numeric(format(as.Date(time, format="%m/%d/%Y"), "%m")),
season = case_when(
month %in% c(12, 1, 2) ~ "Winter",
month %in% c(3, 4, 5) ~ "Spring",
month %in% c(6, 7, 8) ~ "Summer",
month %in% c(9, 10, 11) ~ "Fall",
TRUE ~ NA_character_
))
# Map gunshots by season
season_palette <- colorFactor(palette = c("blue", "green", "yellow", "orange"),
domain = fatal_la$season)
leaflet(data = fatal_la) %>%
addProviderTiles("CartoDB.DarkMatter") %>% # Use CartoDB dark basemap
# Add points for each incident in LA County colored by season
addCircleMarkers(
lng = ~st_coordinates(geometry)[, 1],
lat = ~st_coordinates(geometry)[, 2],
fillColor = ~season_palette(season),
radius = 5,
stroke = TRUE,
weight = 1,
color = "black",
fillOpacity = 0.7,
popup = ~paste("ZIP Code:", GEOID, "<br>", "Season:", season)
) %>%
addLegend("bottomright",
pal = season_palette,
values = ~season,
title = "Season",
opacity = 1)
Having grown up in the Westchester neighborhood (zip code 90045), I was interested in visualizing what time of year most gunshot deaths by police occurred in the area.
# Filter for gunshot incidents in ZIP code 90045
fatal_90045 <- fatal_la %>%
filter(GEOID == "90045")
# Extract month and assign season
fatal_90045 <- fatal_90045 %>%
mutate(month = as.numeric(format(as.Date(time, format="%m/%d/%Y"), "%m")), # Extract month
season = case_when(
month %in% c(12, 1, 2) ~ "Winter",
month %in% c(3, 4, 5) ~ "Spring",
month %in% c(6, 7, 8) ~ "Summer",
month %in% c(9, 10, 11) ~ "Fall",
TRUE ~ NA_character_ # Deal with any NA cases
))
# Create a color palette for different seasons
season_palette <- colorFactor(palette = c("blue", "green", "yellow", "orange"),
domain = fatal_90045$season)
# Create the Leaflet map for 90045 with outlined points and a black basemap
leaflet(data = fatal_90045) %>%
addProviderTiles("CartoDB.DarkMatter") %>% # Use dark basemap
# Add points for each incident in ZIP code 90045 colored by season
addCircleMarkers(
lng = ~st_coordinates(geometry)[, 1],
lat = ~st_coordinates(geometry)[, 2],
fillColor = ~season_palette(season),
radius = 5,
stroke = TRUE,
weight = 1,
color = "black",
fillOpacity = 0.7,
popup = ~paste("ZIP Code:", GEOID, "<br>", "Season:", season)
) %>%
addLegend("bottomright",
pal = season_palette,
values = ~season,
title = "Season",
opacity = 1)
I was surprised to find out that the data only visualized deaths occuring in the latter time periods of the year (Fall and Winter), while there were no data points for Spring and Summer.
# Filter for Spring and Summer incidents in 90045
fatal_90045_spring_summer <- fatal_90045 %>%
filter(month %in% c(3, 4, 5, 6, 7, 8))
# Check if any rows are returned
nrow(fatal_90045_spring_summer)
## [1] 0
I then decided to download ACS data on Median Household Income, and try to answer the question: “Do the number of police killings of civilians rise or fall in wealthier neighborhoods of Los Angeles?”
# Load ACS data for Median Household Income
income_data <- get_acs(geography = "zcta",
variables = "B19013_001", # Median Household Income
year = 2020,
survey = "acs5",
geometry = TRUE)
## Getting data from the 2016-2020 5-year ACS
## Downloading feature geometry from the Census website. To cache shapefiles for use in future sessions, set `options(tigris_use_cache = TRUE)`.
# Filter for Los Angeles County ZCTAs
la_income_data <- income_data %>%
filter(str_starts(GEOID, "900"))
# Merge the income data with gunshot incidents
gunshot_income <- st_join(fatal_la, la_income_data, join = st_within)
# Inspect the merged data
head(gunshot_income)
## Simple feature collection with 6 features and 46 fields
## Geometry type: MULTIPOLYGON
## Dimension: XY
## Bounding box: xmin: -118.2652 ymin: 33.93784 xmax: -118.2265 ymax: 33.96017
## Geodetic CRS: NAD83
## GEOID.x NAME.x variable.x estimate.x moe.x Unique ID
## 1 90002 ZCTA5 90002 B01003_001 53402 2731 19826
## 2 90002 ZCTA5 90002 B01003_001 53402 2731 11119
## 3 90002 ZCTA5 90002 B01003_001 53402 2731 10793
## 4 90002 ZCTA5 90002 B01003_001 53402 2731 10115
## 5 90002 ZCTA5 90002 B01003_001 53402 2731 9820
## 6 90002 ZCTA5 90002 B01003_001 53402 2731 9764
## Name Age Gender Race
## 1 Zelalem Eshetu Ewnetu 28 Male African-American/Black
## 2 Arturo Cabrales 22 Male Hispanic/Latino
## 3 Lee "Lil Yellow Stone" Dyrell Jefferson 23 Male African-American/Black
## 4 Brenda Mae Williams 56 Female African-American/Black
## 5 Earl Bernard Rhodes 48 Male African-American/Black
## 6 D'nary Lamonte Fowler 19 Male African-American/Black
## Race with imputations Imputation probability
## 1 African-American/Black Not imputed
## 2 Hispanic/Latino Not imputed
## 3 African-American/Black Not imputed
## 4 African-American/Black Not imputed
## 5 African-American/Black Not imputed
## 6 African-American/Black Not imputed
## URL of image (PLS NO HOTLINKS)
## 1 https://www.fatalencounters.org/wp-content/uploads/2013/10/Zelalem-Eshetu-Ewnetu.jpg
## 2 <NA>
## 3 http://scontent.cdninstagram.com/hphotos-xpf1/outbound-distilleryimage11/t0.0-17/OBPTH/acef2f64518111e2ab4322000a1fa430_7.jpg
## 4 <NA>
## 5 http://homicide.latimes.com.s3.amazonaws.com/media/homicide/earl_rhodes.jpg
## 6 <NA>
## time Location of injury (address) Location of death (city) State
## 1 04/12/2017 1517 E 91st St Los Angeles CA
## 2 03/07/2012 10321 Lou Dillon Ave. Los Angeles CA
## 3 11/23/2011 822 E. 105th St. Los Angeles CA
## 4 04/27/2011 10020 Anzac Ave. Watts CA
## 5 01/24/2011 951 E. 107th St. Los Angeles CA
## 6 01/02/2011 8759 S. McKinley Place Los Angeles CA
## Location of death (county)
## 1 Los Angeles
## 2 Los Angeles
## 3 Los Angeles
## 4 Los Angeles
## 5 Los Angeles
## 6 Los Angeles
## Full Address Latitude Longitude
## 1 1517 E 91st St Los Angeles CA 90002 Los Angeles 33.9542761 -118.2467
## 2 10321 Lou Dillon Ave. Los Angeles CA 90002 Los Angeles 33.9424332 -118.2348
## 3 822 E. 105th St. Los Angeles CA 90002 Los Angeles 33.9410111 -118.2600
## 4 10020 Anzac Ave. Watts CA 90002 Los Angeles 33.945085 -118.2377
## 5 951 E. 107th St. Los Angeles CA 90002 Los Angeles 33.9392669 -118.2569
## 6 8759 S. McKinley Place Los Angeles CA 90002 Los Angeles 33.9579553 -118.2608
## Agency or agencies involved force UID Temporary
## 1 Los Angeles County Sheriff's Department Gunshot NA
## 2 Los Angeles County Sheriff's Department Gunshot 11119
## 3 Los Angeles Police Department Gunshot 10793
## 4 Los Angeles Police Department Gunshot 10115
## 5 Los Angeles Police Department Gunshot 9820
## 6 Los Angeles Police Department Gunshot 9764
## Name Temporary Armed/Unarmed Alleged weapon
## 1 <NA> Armed Firearm/Handgun
## 2 Arturo Cabrales Uncertain Uncertain
## 3 Lee Dyrell "Lil Yellow Stone" Jefferson Armed Firearm/Gun
## 4 Brenda Mae Williams Armed Firearm/Handgun
## 5 Earl Bernard Rhodes Unarmed None
## 6 D'nary Lamonte Fowler Armed Firearm/Handgun
## Aggressive physical movement Fleeing/Not fleeing
## 1 Brandished weapon Not fleeing
## 2 Uncertain Fleeing/Foot
## 3 Used weapon Fleeing/Foot
## 4 Brandished weapon Not fleeing
## 5 Sudden threatening movement Not fleeing
## 6 Brandished weapon Fleeing/Foot
## Description Temp
## 1 <NA>
## 2 The family of Arturo Cabrales settled for $1.5 million because it was alleged that the deputies involved shot him when he was at his home, running away, and unarmed. The deputies were alleged to be a part of a clique called The Regulators. Also, some of the officials involved were later fired for planting evidence at unrelated crime scene, and for trying to change the scene where they shot Cabrales by claiming that he had a gun that he didn't.
## 3 Officers reported that they were attempting to serve a warrant to Lee Jefferson, and that he was wanted for murder. When confronted, Jefferson fled into a home, took three hostages, exchanged gunfire, and was shot to death by police.
## 4 Officers reported that they responded to a call about a woman shooting at her daughter and grandchildren from her porch. When they arrived they saw Brenda Williams aiming her handgun at a neighbor, and they shot and killed Brenda Williams.
## 5 Officers say they responded to a call about Earl Rhodes not taking his medication and acting erratically. After allegedly fighting with, tasering, shooting a bean bag round, and after Rhodes tried to grab one of the officers' guns, both officers shot him to death.
## 6 Officers reported that they responded to a robbery and found Dnary Fowler holding a gun and the residents bound. When Fowler tried to escape out the back door, officers shot and killed him.
## URL Temp
## 1 <NA>
## 2 https://www.orlandosentinel.com/la-me-ln-county-sheriff-lawsuits-20150217-story.html
## 3 https://beverlypress.com/2011/12/second-suspect-in-smoke-shop-hold-up-killed-in-shootout/
## 4 https://losangeles.cbslocal.com/2011/04/28/woman-56-fatally-shot-by-officers-in-watts-identified/
## 5 http://homicide.latimes.com/post/earl-rhodes/
## 6 https://www.laweekly.com/dnary-fowler-l-a-homicide-no-1-teen-killed-by-lapd-officers-during-alleged-home-invasion-robbery/
## Brief description
## 1 Police were responding to a burglary. They found Ewnetu in a nearby car, and he allegedly pulled a gun out of his car before he was shot and killed.
## 2 The family of Cabrales settled for $1.5 million because it was alleged that the deputies involved shot him when he was at his home, running away, and unarmed. The deputies were alleged to be a part of a clique called The Regulators. Also, some of the officials involved were later fired for planting evidence at unrelated crime scene, and for trying to change the scene where they shot Cabrales by claiming that he had a gun that he didn't.
## 3 Officers reported that they were attempting to serve a warrant to Jefferson, and that he was wanted for murder. When confronted, he fled, exchanged gunfire, and was shot to death by police.
## 4 Officers reported that they responded to a call about a woman shooting at her daughter and grandchildren. When they arrived they saw Williams aiming her weapon at a neighbor, and they shot her to death.
## 5 Officers say they responded to a call about Rhodes not taking his medication and acting erratically. After fighting with, tasering, shooting a bean bag round, and after Rhodes tried to grab one of the officers gun, both officers shot him to death.
## 6 Officers reported that they responded to a robbery and found Fowler holding a gun and the residents bound. When Fowler tried to escape out the back door, officers shot him to death.
## Dispositions/Exclusions INTERNAL USE, NOT FOR ANALYSIS
## 1 Pending investigation
## 2 Unreported
## 3 Unreported
## 4 Unreported
## 5 Unreported
## 6 Unreported
## Intended use of force (Developing)
## 1 Deadly force
## 2 Deadly force
## 3 Deadly force
## 4 Deadly force
## 5 Deadly force
## 6 Deadly force
## Supporting document link
## 1 http://ktla.com/2017/04/12/man-fatally-shot-by-deputies-responding-to-burglary-call-in-south-l-a-area/
## 2 http://www.laweekly.com/news/family-of-man-slain-by-sheriffs-deputy-awarded-15-million-4813197
## 3 http://homicide.latimes.com/post/lee-jefferson/
## 4 http://homicide.latimes.com/post/brenda-williams/
## 5 http://homicide.latimes.com/post/earl-rhodes/
## 6 http://homicide.latimes.com/post/dnary-fowler/
## ...32 ...33 Unique ID formula Unique identifier (redundant) month season
## 1 NA NA NA 19826 4 Spring
## 2 NA NA NA 11119 3 Spring
## 3 NA NA NA 10793 11 Fall
## 4 NA NA NA 10115 4 Spring
## 5 NA NA NA 9820 1 Winter
## 6 NA NA NA 9764 1 Winter
## GEOID.y NAME.y variable.y estimate.y moe.y
## 1 90002 ZCTA5 90002 B19013_001 42245 3094
## 2 90002 ZCTA5 90002 B19013_001 42245 3094
## 3 90002 ZCTA5 90002 B19013_001 42245 3094
## 4 90002 ZCTA5 90002 B19013_001 42245 3094
## 5 90002 ZCTA5 90002 B19013_001 42245 3094
## 6 90002 ZCTA5 90002 B19013_001 42245 3094
## geometry
## 1 MULTIPOLYGON (((-118.2652 3...
## 2 MULTIPOLYGON (((-118.2652 3...
## 3 MULTIPOLYGON (((-118.2652 3...
## 4 MULTIPOLYGON (((-118.2652 3...
## 5 MULTIPOLYGON (((-118.2652 3...
## 6 MULTIPOLYGON (((-118.2652 3...
# Rename the 'estimate' column to 'MHIncome'
gunshot_income <- gunshot_income %>%
rename(MHIncome = estimate.x)
gunshot_income_aggregated <- gunshot_income %>%
group_by(GEOID.x) %>%
summarise(
gunshot_count = n(), # Count gunshot incidents per ZCTA
MHIncome = first(MHIncome) # Use renamed column 'MHIncome'
)
# Plot the relationship between MHIncome and gunshot incidents
ggplot(gunshot_income_aggregated, aes(x = MHIncome, y = gunshot_count)) +
geom_point(color = "blue", alpha = 0.7) +
labs(
title = "Relationship Between Median Household Income and Gunshot Incidents in LA County",
x = "Median Household Income ($)",
y = "Number of Gunshot Incidents"
) +
theme_minimal()
The scatterplot tells a story of certain income ranges having a higher number of incidents, but there is a lack of a strong trend, indicating that there is not a direct correlation. There is a concentration of points at lower income levels, suggesting that lower income areas don’t necessarily have a higher number of gunshot incidents. Factors other than income may influence police-on-civilian gun violence in these regions of Los Angeles.
I then implemented a regression line, which somewhat surprisingly indiciated a positive relationship between income and gunshot incidents, suggesting that higher median hosuehold income is associated with an increase in gunshot incidents in these areas.
# Aggregate data to get the number of gunshot incidents per zip code
gunshot_income_aggregated <- gunshot_income %>%
group_by(GEOID.x, MHIncome) %>% # Group by GEOID and median household income
summarise(gunshot_count = n()) # Count the number of gunshot incidents
# Inspect the aggregated dataset
head(gunshot_income_aggregated)
## Simple feature collection with 6 features and 3 fields
## Geometry type: GEOMETRY
## Dimension: XY
## Bounding box: xmin: -118.3387 ymin: 33.93784 xmax: -118.2265 ymax: 34.06399
## Geodetic CRS: NAD83
## # A tibble: 6 × 4
## # Groups: GEOID.x [6]
## GEOID.x MHIncome gunshot_count geometry
## <chr> <dbl> <int> <GEOMETRY [°]>
## 1 90001 58974 7 POLYGON ((-118.2652 33.98195, -118.263 33.9818…
## 2 90002 53402 10 POLYGON ((-118.2652 33.94684, -118.2643 33.946…
## 3 90003 74117 18 POLYGON ((-118.2832 33.97945, -118.2832 33.977…
## 4 90005 38885 3 MULTIPOLYGON (((-118.3016 34.06174, -118.301 3…
## 5 90006 58560 6 POLYGON ((-118.3101 34.04356, -118.309 34.0435…
## 6 90007 42380 14 POLYGON ((-118.3008 34.02912, -118.3008 34.027…
# Plot
ggplot(gunshot_income_aggregated, aes(x = MHIncome, y = gunshot_count)) + # Use gunshot_count as y
geom_point(color = "blue", alpha = 0.7) + # Plot points
geom_smooth(method = "lm", formula = y ~ x, color = "red") + # Add regression line
labs(
title = "Relationship Between Median Household Income and Gunshot Incidents in Los Angeles",
x = "Median Household Income ($)",
y = "Number of Gunshot Incidents"
) +
theme_minimal()
The lack of a strong correlation suggests that other variables, such as systemic socioeconomic issues, policing strategies, and community relations might influence the outcomes significantly, rather than season or income.
# Create an Interactive map
# Define income breaks and labels
income_breaks <- c(0, 40000, 80000, 120000, 160000, 200000)
income_labels <- c("0 - $40,000", "$40,000 - $80,000", "$80,000 - $120,000", "$120,000 - $160,000", "$160,000+")
# Create a color palette based on defined breaks
income_palette <- colorBin("YlGn", domain = la_income_data$estimate, bins = income_breaks)
# Create the Leaflet map
leaflet(data = fatal_la) %>%
addProviderTiles("CartoDB.Positron") %>% # Use minimalist basemap
# Add polygons for median household income
addPolygons(data = la_income_data,
fillColor = ~income_palette(estimate),
color = "black",
weight = 1,
opacity = 1,
fillOpacity = 0.7,
popup = ~paste("ZIP Code:", GEOID, "<br>", "Median Household Income: $", estimate),
group = "Income") %>%
# Add points for each gunshot incident
addCircleMarkers(
lng = ~st_coordinates(geometry)[, 1],
lat = ~st_coordinates(geometry)[, 2],
fillColor = ~force_palette(force),
radius = 5,
stroke = TRUE,
weight = 1,
color = "black",
fillOpacity = 0.7,
popup = ~paste("ZIP Code:", GEOID, "<br>", "Force Level:", force),
group = "Gunshot Incidents"
) %>%
# Add legend for median household income
addLegend("bottomleft",
pal = income_palette,
values = la_income_data$estimate,
title = "Median Household Income",
opacity = 1,
labFormat = labelFormat(prefix = "$")) %>% # Format labels with dollar sign
# Add legend for the force levels
addLegend("bottomright",
pal = force_palette,
values = ~force,
title = "Level of Force",
opacity = 1) %>%
# Add layer control to toggle between incident points and income polygons
addLayersControl(
overlayGroups = c("Income", "Gunshot Incidents"),
options = layersControlOptions(collapsed = FALSE)
)
References
Fatal Encounters. (n.d.). Fatal encounters: Police killings in the United States. https://fatalencounters.org/
U.S. Census Bureau. (2023). American Community Survey 5-year estimates. https://www.census.gov/programs-surveys/acs