Instructions

In 2020, after many frustrations in obtaining the data on police killings of civilians, Brian Burghart of USC began to collect his own data from various sources in the US. He called the database Fatal Encounters. Your assignment is to tell a compelling story about police killings in this country – it does not have to be comprehensive.

  1. Import the data into R and explore.
  2. Tell a narrative account of your findings (no more than 300 words), supported by at least four interesting graphics/maps.
# Load packages
# install.packages(c("tidyverse", "maps", "scales"))   # run once if not installed
library(tidyverse)   # readr, dplyr, ggplot2, lubridate, stringr
library(lubridate)   # mdy() for parsing month/day/year dates
library(scales)      # percent() and comma() axis labels
library(maps)        # US state outlines used by map_data("state")

Data import and cleaning

# Read the 'Form Responses' sheet exported as CSV.
# Look for any CSV with "fatal" and "encounters" in its name in this .Rmd's folder,
# so it works whatever the exact downloaded file name is (with or without parentheses).
csv_file <- list.files(pattern = "fatal.*encounters.*\\.csv$", ignore.case = TRUE)
# If running chunks by hand and nothing is found, let me pick the file in a dialog
if (length(csv_file) == 0 && interactive()) csv_file <- file.choose()
if (length(csv_file) == 0) stop("No Fatal Encounters CSV found in: ", getwd())
fe_raw <- read_csv(csv_file[1], show_col_types = FALSE)

# One column name has a leading space (" Date of injury ..."), so trim all names
names(fe_raw) <- str_trim(names(fe_raw))

dim(fe_raw)   # how many rows and columns came in
## [1] 31498    35
fe <- fe_raw %>%
  # Drop the spacer row at the bottom of the sheet (it has no Unique ID)
  filter(!is.na(`Unique ID`)) %>%
  # Turn the month/day/year text into a real Date and pull out the year
  mutate(date = mdy(`Date of injury resulting in death (month/day/year)`),
         year = year(date)) %>%
  # Exclude deaths the database codes as suicides; this story is about deaths caused by police action
  filter(`Intended use of force (Developing)` != "Suicide") %>%
  mutate(
    # Age is stored as text (some entries are blank/odd), so convert to numeric
    age = suppressWarnings(as.numeric(Age)),
    # Fix typos in the imputed race field (e.g., "HIspanic", lowercase "european")
    race = `Race with imputations` %>%
      str_trim() %>%
      str_replace("HIspanic", "Hispanic") %>%
      str_replace("^european", "European"),
    # Collapse cause of death into three groups for the trend chart
    force = case_when(
      `Highest level of force` == "Gunshot" ~ "Gunshot",
      `Highest level of force` == "Vehicle" ~ "Vehicle / pursuit",
      TRUE                                  ~ "Other (taser, restraint, etc.)"),
    # Fix the "Arrmed" typo and keep only clean armed categories
    armed = recode(`Armed/Unarmed`, "Arrmed" = "Armed"),
    armed = if_else(armed %in% c("Armed", "Unarmed", "Uncertain"), armed, NA_character_),
    # Latitude is read as text; convert to numeric for mapping
    lat = suppressWarnings(as.numeric(Latitude)),
    lon = Longitude
  )

# Quick checks: number of cases and the years covered
nrow(fe)
## [1] 28151
range(fe$year, na.rm = TRUE)
## [1] 2000 2021

Narrative

(Draft — rewrite this in your own words before you submit; it must stay under 300 words.)

Fatal Encounters has 28,151 deaths at police contacts from 2000 to 2021, with suicide excluded. The annual death toll increased more than twofold: 795 in the year 2000 and peaked at 1,804 in the year 2020 (Figure 1). Two-thirds of the deaths resulted from shooting and the rest from pursuit by police officers via vehicle; this causes crashes, which are an under reported factor responsible for at least over 500 deaths in years 2020 and 2021 alone which is nearly one-third of those killed by police officers across the nation.

Most victims are not dying with homogeneity variance. A rate adjusted for the total population shows that black Americans are three times more than white Americans per million people per year, with a rate of about 3 per million, while the rate among Native Americans is approximately 6 per million, or double that of whites, as shown in (Figure 2).

The difference is continued when questioned if a person was charged with a weapon offense: (mostly 2011 onward) among shooting victims for whom police kept records on arresting armed persons, 20% of Victim Group B blacks were unarmed, while only 14% of white victims were unarmed (Figure 3). Compared with whites, blacks rank lowest in median age, 29, seven years younger than whites at 36, (Figure 5).

This correlates with Geographically, deaths follow population (Figure 4). California, Texas, Florida, and Georgia record the most deaths, and the eastern half of the country is densely covered while the Mountain West is nearly empty outside its cities. However, the Mountain West is basically empty-very closely. The type of departure varies similarly: More than one-third of the deaths in Michigan, Kansas, and South Carolina are from pursuits, while this type of death is only about one-tenth in Arizona and Nevada.

This shows that police killings have steadily increased, comprising things other than simply shooting, and nearly all Black and Native American communities suffer most. This dataset relies on news stories and record requests. Therefore, race is only partly imputed, and half of the records are missing data on whether the “victim” was armed.

Figure 1: Deaths per year by cause

# Count deaths by year and cause-of-death group
by_year <- fe %>%
  filter(!is.na(year)) %>%
  count(year, force)

# Line chart: one line per cause, showing the trend over time
ggplot(by_year, aes(x = year, y = n, color = force)) +
  geom_line(linewidth = 1) +
  geom_point(size = 1.5) +
  scale_y_continuous(labels = comma) +
  labs(title = "Police-involved deaths keep rising, and pursuits are a growing share",
       subtitle = "Fatal Encounters, 2000–2021 (suicides excluded)",
       x = NULL, y = "Deaths", color = "Cause of death",
       caption = "Source: FatalEncounters.org") +
  theme_minimal() +
  theme(legend.position = "top")

Figure 2: Death rate by race

# Approximate 2020 Census population (millions), non-Hispanic for each race group,
# so the rate compares deaths to the size of each group.
pop <- tibble(
  race = c("European-American/White", "African-American/Black", "Hispanic/Latino",
           "Asian/Pacific Islander", "Native American/Alaskan"),
  pop_millions = c(191.7, 39.9, 62.1, 20.2, 2.3)
)

n_years <- n_distinct(fe$year[!is.na(fe$year)])   # 22 years (2000–2021)

rate_by_race <- fe %>%
  count(race) %>%
  inner_join(pop, by = "race") %>%                     # keep groups with a population figure
  mutate(rate = n / n_years / pop_millions)            # deaths per million people per year

# Bar chart ordered from highest to lowest rate
ggplot(rate_by_race, aes(x = reorder(race, rate), y = rate)) +
  geom_col(fill = "#8c2d04") +
  geom_text(aes(label = round(rate, 1)), hjust = -0.2) +
  coord_flip() +
  expand_limits(y = max(rate_by_race$rate) * 1.1) +
  labs(title = "Black Americans are killed at about 3x the rate of white Americans",
       subtitle = "Average deaths per million people per year, 2000–2021",
       x = NULL, y = "Deaths per million per year",
       caption = "Source: FatalEncounters.org; 2020 Census (approx.)") +
  theme_minimal()

Figure 3: Unarmed share among people shot

# Among shooting deaths with a recorded armed status, what share were unarmed?
unarmed <- fe %>%
  filter(force == "Gunshot",
         armed %in% c("Armed", "Unarmed"),
         race %in% pop$race) %>%
  group_by(race) %>%
  summarise(n = n(),
            share_unarmed = mean(armed == "Unarmed"))

ggplot(unarmed, aes(x = reorder(race, share_unarmed), y = share_unarmed)) +
  geom_col(fill = "#2b8cbe") +
  geom_text(aes(label = percent(share_unarmed, accuracy = 1)), hjust = -0.2) +
  coord_flip() +
  scale_y_continuous(labels = percent, limits = c(0, 0.3)) +
  labs(title = "Black victims of police shootings were more likely to be unarmed",
       subtitle = "Share unarmed among people shot (where armed status is recorded)",
       x = NULL, y = "Share unarmed",
       caption = "Source: FatalEncounters.org") +
  theme_minimal()

Figure 4: Map of deaths

# State outlines for the lower 48 (from the maps package)
states <- map_data("state")

# Keep points inside the continental US box so Alaska/Hawaii don't stretch the map
fe_map <- fe %>%
  filter(between(lat, 24, 50), between(lon, -125, -66))

ggplot() +
  geom_polygon(data = states, aes(long, lat, group = group),
               fill = "grey95", color = "grey70", linewidth = 0.2) +
  geom_point(data = fe_map, aes(lon, lat, color = force),
             size = 0.3, alpha = 0.35) +
  coord_quickmap() +
  guides(color = guide_legend(override.aes = list(size = 3, alpha = 1))) +
  labs(title = "Where police-involved deaths happened, 2000–2021",
       color = "Cause of death",
       caption = "Source: FatalEncounters.org") +
  theme_void() +
  theme(legend.position = "bottom")

(Optional) Figure 5: Age of victims by race

# Age distribution by race; median age printed below
fe %>%
  filter(race %in% c("European-American/White", "African-American/Black", "Hispanic/Latino"),
         !is.na(age)) %>%
  ggplot(aes(x = age, fill = race)) +
  geom_density(alpha = 0.4) +
  labs(title = "Black and Hispanic victims skew younger",
       x = "Age", y = "Density", fill = NULL) +
  theme_minimal() +
  theme(legend.position = "top")

# Median age by race (used in the narrative)
fe %>% group_by(race) %>% summarise(median_age = median(age, na.rm = TRUE))
## # A tibble: 8 × 2
##   race                    median_age
##   <chr>                        <dbl>
## 1 African-American/Black          29
## 2 Asian/Pacific Islander          32
## 3 European-American/White         36
## 4 Hispanic/Latino                 30
## 5 Middle Eastern                  27
## 6 Native American/Alaskan         30
## 7 Race unspecified                33
## 8 <NA>                            34