# Load data
wapo.data <- read.csv(
  "https://raw.githubusercontent.com/washingtonpost/data-police-shootings/master/v2/fatal-police-shootings-data.csv",
  stringsAsFactors = FALSE
)

# Clean data
wapo.data$date <- as.Date(wapo.data$date)
wapo.data$month <- substr(wapo.data$date, 6, 7)
wapo.data$year <- substr(wapo.data$date, 1, 4)

wapo.data$city <- gsub("Bronx", "New York", wapo.data$city)
wapo.data$city <- gsub("Brooklyn", "New York", wapo.data$city)
wapo.data$city <- gsub("Manhattan", "New York", wapo.data$city)
wapo.data$city <- gsub("Queens", "New York", wapo.data$city)
wapo.data$city <- gsub("Staten Island", "New York", wapo.data$city)

wapo.data$statecity <- paste(wapo.data$state, wapo.data$city, sep = "-")

wapo.data$race <- gsub("W;B;N", "W", wapo.data$race)
wapo.data$race <- gsub("N;H", "N", wapo.data$race)
wapo.data$race <- gsub("W;H", "W", wapo.data$race)
wapo.data$race <- gsub("B;H", "B", wapo.data$race)
wapo.data$race <- gsub("W;B", "W", wapo.data$race)
wapo.data$race <- gsub("W;A", "W", wapo.data$race)

# Create city list
project3.cities <- data.frame(
  city = c(
    "Austin", "Baltimore", "Boston", "Charlotte", "Chicago",
    "Cleveland", "Columbus", "Dallas", "Denver", "Detroit",
    "El Paso", "Houston", "Indianapolis", "Kansas City",
    "Las Vegas", "Long Beach", "Los Angeles", "Louisville",
    "Memphis", "Milwaukee", "Minneapolis", "Nashville",
    "New York", "Oakland", "Oklahoma City", "Philadelphia",
    "Phoenix", "Portland", "San Antonio", "San Diego",
    "San Francisco", "San Jose", "Seattle", "Tucson",
    "Washington"
  ),
  state = c(
    "TX", "MD", "MA", "NC", "IL",
    "OH", "OH", "TX", "CO", "MI",
    "TX", "TX", "IN", "MO",
    "NV", "CA", "CA", "KY",
    "TN", "WI", "MN", "TN",
    "NY", "CA", "OK", "PA",
    "AZ", "OR", "TX", "CA",
    "CA", "CA", "WA", "AZ",
    "DC"
  ),
  stringsAsFactors = FALSE
)

project3.cities$statecity <- paste(project3.cities$state, project3.cities$city, sep = "-")

# Join project cities to WaPo data
project3 <- project3.cities %>%
  left_join(wapo.data, by = "statecity")

# Total events
project3.events <- project3 %>%
  group_by(statecity) %>%
  summarise(count = n(), .groups = "drop")

dc_events <- project3.events %>%
  filter(statecity == "DC-Washington") %>%
  pull(count)

project3.events <- project3.events %>%
  mutate(diff = abs(count - dc_events)) %>%
  arrange(diff) %>%
  mutate(rank.events = row_number() - 1)

# Flee status
project3.flee <- project3 %>%
  group_by(statecity, flee_status) %>%
  summarise(count = n(), .groups = "drop_last") %>%
  mutate(pct = round(count / sum(count) * 100, 2)) %>%
  ungroup() %>%
  filter(flee_status == "not")

dc_flee <- project3.flee %>%
  filter(statecity == "DC-Washington") %>%
  pull(pct)

project3.flee <- project3.flee %>%
  mutate(diff = abs(pct - dc_flee)) %>%
  arrange(diff) %>%
  mutate(rank.flee = row_number() - 1)

# Armed with gun
project3.armed <- project3 %>%
  group_by(statecity, armed_with) %>%
  summarise(count = n(), .groups = "drop_last") %>%
  mutate(pct = round(count / sum(count) * 100, 2)) %>%
  ungroup() %>%
  filter(armed_with == "gun")

dc_armed <- project3.armed %>%
  filter(statecity == "DC-Washington") %>%
  pull(pct)

project3.armed <- project3.armed %>%
  mutate(diff = abs(pct - dc_armed)) %>%
  arrange(diff) %>%
  mutate(rank.armed = row_number() - 1)

# Gender
project3.gender <- project3 %>%
  group_by(statecity, gender) %>%
  summarise(count = n(), .groups = "drop_last") %>%
  mutate(pct = round(count / sum(count) * 100, 2)) %>%
  ungroup() %>%
  filter(gender == "male")

dc_gender <- project3.gender %>%
  filter(statecity == "DC-Washington") %>%
  pull(pct)

project3.gender <- project3.gender %>%
  mutate(diff = abs(pct - dc_gender)) %>%
  arrange(diff) %>%
  mutate(rank.gender = row_number() - 1)

# Race
project3.race <- project3 %>%
  group_by(statecity, race) %>%
  summarise(count = n(), .groups = "drop_last") %>%
  mutate(pct = round(count / sum(count) * 100, 2)) %>%
  ungroup() %>%
  filter(race == "B")

dc_race <- project3.race %>%
  filter(statecity == "DC-Washington") %>%
  pull(pct)

project3.race <- project3.race %>%
  mutate(diff = abs(pct - dc_race)) %>%
  arrange(diff) %>%
  mutate(rank.race = row_number() - 1)

# Mental illness
project3.mental <- project3 %>%
  group_by(statecity, was_mental_illness_related) %>%
  summarise(count = n(), .groups = "drop_last") %>%
  mutate(pct = round(count / sum(count) * 100, 2)) %>%
  ungroup() %>%
  filter(was_mental_illness_related == "False")

dc_mental <- project3.mental %>%
  filter(statecity == "DC-Washington") %>%
  pull(pct)

project3.mental <- project3.mental %>%
  mutate(diff = abs(pct - dc_mental)) %>%
  arrange(diff) %>%
  mutate(rank.mental = row_number() - 1)

# Body camera
project3.camera <- project3 %>%
  group_by(statecity, body_camera) %>%
  summarise(count = n(), .groups = "drop_last") %>%
  mutate(pct = round(count / sum(count) * 100, 2)) %>%
  ungroup() %>%
  filter(body_camera == "False")

dc_camera <- project3.camera %>%
  filter(statecity == "DC-Washington") %>%
  pull(pct)

project3.camera <- project3.camera %>%
  mutate(diff = abs(pct - dc_camera)) %>%
  arrange(diff) %>%
  mutate(rank.camera = row_number() - 1)

# Merge all results into one final dataset
events.sub <- project3.events %>%
  select(statecity, count, rank.events) %>%
  rename(events = count)

flee.sub <- project3.flee %>%
  select(statecity, pct.flee = pct, rank.flee)

armed.sub <- project3.armed %>%
  select(statecity, pct.armed = pct, rank.armed)

gender.sub <- project3.gender %>%
  select(statecity, pct.gender = pct, rank.gender)

race.sub <- project3.race %>%
  select(statecity, pct.race = pct, rank.race)

mental.sub <- project3.mental %>%
  select(statecity, pct.mental = pct, rank.mental)

camera.sub <- project3.camera %>%
  select(statecity, pct.camera = pct, rank.camera)

project3.final <- project3.cities %>%
  select(statecity) %>%
  left_join(events.sub, by = "statecity") %>%
  left_join(flee.sub, by = "statecity") %>%
  left_join(armed.sub, by = "statecity") %>%
  left_join(gender.sub, by = "statecity") %>%
  left_join(race.sub, by = "statecity") %>%
  left_join(mental.sub, by = "statecity") %>%
  left_join(camera.sub, by = "statecity")

kable(project3.final)
statecity events rank.events pct.flee rank.flee pct.armed rank.armed pct.gender rank.gender pct.race rank.race pct.mental rank.mental pct.camera rank.camera
TX-Austin 48 23 60.42 22 66.67 18 91.67 2 14.58 30 70.83 29 62.50 10
MD-Baltimore 33 5 63.64 26 69.70 21 100.00 30 96.97 2 84.85 5 51.52 1
MA-Boston 10 24 50.00 2 70.00 22 100.00 29 60.00 11 60.00 34 80.00 26
NC-Charlotte 29 2 65.52 29 72.41 28 93.10 6 55.17 12 65.52 33 72.41 17
IL-Chicago 57 28 29.82 32 73.68 30 96.49 20 77.19 4 92.98 24 73.68 19
OH-Cleveland 16 19 50.00 4 81.25 33 100.00 31 87.50 1 81.25 8 68.75 13
OH-Columbus 51 25 56.86 18 60.78 6 92.16 4 62.75 10 92.16 20 70.59 16
TX-Dallas 27 7 59.26 20 77.78 32 96.30 18 40.74 19 92.59 21 66.67 11
CO-Denver 56 27 50.00 0 58.93 2 91.07 1 19.64 25 92.86 23 89.29 30
MI-Detroit 33 6 60.61 23 66.67 17 93.94 9 54.55 14 69.70 31 75.76 20
TX-El Paso 27 8 48.15 11 48.15 14 96.30 19 7.41 34 81.48 6 100.00 34
TX-Houston 125 32 46.40 12 71.20 26 99.20 27 50.40 15 82.40 4 73.60 18
IN-Indianapolis 44 18 43.18 17 70.45 23 97.73 24 72.73 5 84.09 3 50.00 2
MO-Kansas City 42 15 50.00 3 73.81 31 95.24 14 54.76 13 90.48 17 97.62 33
NV-Las Vegas 86 30 59.30 21 61.63 7 96.51 21 25.58 23 70.93 28 58.14 4
CA-Long Beach 27 4 62.96 25 40.74 29 81.48 3 25.93 22 88.89 13 77.78 24
CA-Los Angeles 157 34 49.68 6 50.96 9 94.90 12 22.29 24 87.26 10 77.07 22
KY-Louisville 37 12 56.76 16 59.46 3 97.30 22 37.84 21 89.19 14 45.95 7
TN-Memphis 30 1 26.67 33 63.33 11 93.33 8 80.00 3 93.33 25 90.00 31
WI-Milwaukee 27 9 44.44 15 81.48 34 100.00 34 70.37 7 81.48 7 44.44 9
MN-Minneapolis 15 20 66.67 30 60.00 5 93.33 7 66.67 8 80.00 9 46.67 6
TN-Nashville 20 14 65.00 28 65.00 13 95.00 13 50.00 17 70.00 30 45.00 8
NY-New York 77 29 50.65 8 58.44 1 98.70 26 71.43 6 72.73 26 70.13 15
CA-Oakland 14 21 64.29 27 64.29 12 100.00 28 50.00 16 92.86 22 78.57 25
OK-Oklahoma City 47 22 51.06 9 65.96 15 95.74 16 40.43 20 78.72 11 59.57 5
PA-Philadelphia 42 16 50.00 5 61.90 8 100.00 33 64.29 9 90.48 18 80.95 27
AZ-Phoenix 130 33 56.92 19 60.00 4 95.38 15 16.92 29 88.46 12 81.54 28
OR-Portland 31 3 45.16 13 45.16 19 100.00 32 19.35 26 77.42 15 96.77 32
TX-San Antonio 101 31 50.50 7 66.34 16 94.06 10 9.90 32 91.09 19 77.23 23
CA-San Diego 38 13 55.26 14 42.11 27 97.37 23 18.42 28 71.05 27 36.84 14
CA-San Francisco 26 10 76.92 34 42.31 24 92.31 5 19.23 27 76.92 16 57.69 3
CA-San Jose 26 11 69.23 31 42.31 25 96.15 17 7.69 33 69.23 32 76.92 21
WA-Seattle 18 17 38.89 24 44.44 20 94.44 11 44.44 18 83.33 2 38.89 12
AZ-Tucson 54 26 51.85 10 62.96 10 98.15 25 11.11 31 83.33 0 87.04 29
DC-Washington 30 0 50.00 1 56.67 0 86.67 0 90.00 0 83.33 1 53.33 0 
# Top cities most similar to DC by event rank
project3.final %>%
  arrange(rank.events) %>%
  head(10) %>%
  kable()
statecity events rank.events pct.flee rank.flee pct.armed rank.armed pct.gender rank.gender pct.race rank.race pct.mental rank.mental pct.camera rank.camera
DC-Washington 30 0 50.00 1 56.67 0 86.67 0 90.00 0 83.33 1 53.33 0
TN-Memphis 30 1 26.67 33 63.33 11 93.33 8 80.00 3 93.33 25 90.00 31
NC-Charlotte 29 2 65.52 29 72.41 28 93.10 6 55.17 12 65.52 33 72.41 17
OR-Portland 31 3 45.16 13 45.16 19 100.00 32 19.35 26 77.42 15 96.77 32
CA-Long Beach 27 4 62.96 25 40.74 29 81.48 3 25.93 22 88.89 13 77.78 24
MD-Baltimore 33 5 63.64 26 69.70 21 100.00 30 96.97 2 84.85 5 51.52 1
MI-Detroit 33 6 60.61 23 66.67 17 93.94 9 54.55 14 69.70 31 75.76 20
TX-Dallas 27 7 59.26 20 77.78 32 96.30 18 40.74 19 92.59 21 66.67 11
TX-El Paso 27 8 48.15 11 48.15 14 96.30 19 7.41 34 81.48 6 100.00 34
WI-Milwaukee 27 9 44.44 15 81.48 34 100.00 34 70.37 7 81.48 7 44.44 9 
# Step 1: Load data
wapo.data <- read.csv(
  "https://raw.githubusercontent.com/washingtonpost/data-police-shootings/master/v2/fatal-police-shootings-data.csv",
  stringsAsFactors = FALSE
)

# Step 2: Clean data
wapo.data$date <- as.Date(wapo.data$date)
wapo.data$year <- substr(wapo.data$date, 1, 4)

wapo.data$city <- gsub("Bronx", "New York", wapo.data$city)
wapo.data$city <- gsub("Brooklyn", "New York", wapo.data$city)
wapo.data$city <- gsub("Manhattan", "New York", wapo.data$city)
wapo.data$city <- gsub("Queens", "New York", wapo.data$city)
wapo.data$city <- gsub("Staten Island", "New York", wapo.data$city)

wapo.data$statecity <- paste(wapo.data$state, wapo.data$city, sep = "-")

wapo.data$race <- gsub("W;B;N", "W", wapo.data$race)
wapo.data$race <- gsub("N;H", "N", wapo.data$race)
wapo.data$race <- gsub("W;H", "W", wapo.data$race)
wapo.data$race <- gsub("B;H", "B", wapo.data$race)
wapo.data$race <- gsub("W;B", "W", wapo.data$race)
wapo.data$race <- gsub("W;A", "W", wapo.data$race)

wapo.data.map <- subset(wapo.data, !is.na(latitude) & !is.na(longitude))

# Step 3: Descriptive tables
wapo.city <- wapo.data %>% 
  group_by(statecity) %>% 
  summarise(count = n(), .groups = "drop") %>% 
  mutate(pct = round(count / sum(count) * 100, 2))

wapo.flee <- wapo.data %>% 
  group_by(flee_status) %>% 
  summarise(count = n(), .groups = "drop") %>% 
  mutate(pct = round(count / sum(count) * 100, 2))

wapo.armed <- wapo.data %>% 
  group_by(armed_with) %>% 
  summarise(count = n(), .groups = "drop") %>% 
  mutate(pct = round(count / sum(count) * 100, 2))

wapo.gender <- wapo.data %>% 
  group_by(gender) %>% 
  summarise(count = n(), .groups = "drop") %>% 
  mutate(pct = round(count / sum(count) * 100, 2))

wapo.race <- wapo.data %>% 
  group_by(race) %>% 
  summarise(count = n(), .groups = "drop") %>% 
  mutate(pct = round(count / sum(count) * 100, 2))

wapo.mental <- wapo.data %>% 
  group_by(was_mental_illness_related) %>% 
  summarise(count = n(), .groups = "drop") %>% 
  mutate(pct = round(count / sum(count) * 100, 2))

wapo.camera <- wapo.data %>% 
  group_by(body_camera) %>% 
  summarise(count = n(), .groups = "drop") %>% 
  mutate(pct = round(count / sum(count) * 100, 2))

# Step 4: Create city list
project3.cities <- data.frame(
  city = c(
    "Austin", "Baltimore", "Boston", "Charlotte", "Chicago",
    "Cleveland", "Columbus", "Dallas", "Denver", "Detroit",
    "El Paso", "Houston", "Indianapolis", "Kansas City",
    "Las Vegas", "Long Beach", "Los Angeles", "Louisville",
    "Memphis", "Milwaukee", "Minneapolis", "Nashville",
    "New York", "Oakland", "Oklahoma City", "Philadelphia",
    "Phoenix", "Portland", "San Antonio", "San Diego",
    "San Francisco", "San Jose", "Seattle", "Tucson",
    "Washington"
  ),
  state = c(
    "TX", "MD", "MA", "NC", "IL",
    "OH", "OH", "TX", "CO", "MI",
    "TX", "TX", "IN", "MO",
    "NV", "CA", "CA", "KY",
    "TN", "WI", "MN", "TN",
    "NY", "CA", "OK", "PA",
    "AZ", "OR", "TX", "CA",
    "CA", "CA", "WA", "AZ",
    "DC"
  ),
  stringsAsFactors = FALSE
)

project3.cities$statecity <- paste(project3.cities$state, project3.cities$city, sep = "-")

project3 <- project3.cities %>%
  left_join(wapo.data, by = "statecity")

# Step 5: Build ranking tables

# total events
project3.events <- project3 %>%
  group_by(statecity) %>%
  summarise(count = n(), .groups = "drop")

dc_events <- project3.events %>%
  filter(statecity == "DC-Washington") %>%
  pull(count)

project3.events <- project3.events %>%
  mutate(diff = abs(count - dc_events)) %>%
  arrange(diff) %>%
  mutate(rank.event = row_number() - 1)

# flee status
project3.flee <- project3 %>%
  group_by(statecity, flee_status) %>%
  summarise(count = n(), .groups = "drop_last") %>%
  mutate(pct.flee = round(count / sum(count) * 100, 2)) %>%
  ungroup() %>%
  filter(flee_status == "not")

dc_flee <- project3.flee %>%
  filter(statecity == "DC-Washington") %>%
  pull(pct.flee)

project3.flee <- project3.flee %>%
  mutate(diff = abs(pct.flee - dc_flee)) %>%
  arrange(diff) %>%
  mutate(rank.flee = row_number() - 1)

# armed with
project3.armed <- project3 %>%
  group_by(statecity, armed_with) %>%
  summarise(count = n(), .groups = "drop_last") %>%
  mutate(pct.armed = round(count / sum(count) * 100, 2)) %>%
  ungroup() %>%
  filter(armed_with == "gun")

dc_armed <- project3.armed %>%
  filter(statecity == "DC-Washington") %>%
  pull(pct.armed)

project3.armed <- project3.armed %>%
  mutate(diff = abs(pct.armed - dc_armed)) %>%
  arrange(diff) %>%
  mutate(rank.armed = row_number() - 1)

# gender
project3.gender <- project3 %>%
  group_by(statecity, gender) %>%
  summarise(count = n(), .groups = "drop_last") %>%
  mutate(pct.gender = round(count / sum(count) * 100, 2)) %>%
  ungroup() %>%
  filter(gender == "male")

dc_gender <- project3.gender %>%
  filter(statecity == "DC-Washington") %>%
  pull(pct.gender)

project3.gender <- project3.gender %>%
  mutate(diff = abs(pct.gender - dc_gender)) %>%
  arrange(diff) %>%
  mutate(rank.gender = row_number() - 1)

# race
project3.race <- project3 %>%
  group_by(statecity, race) %>%
  summarise(count = n(), .groups = "drop_last") %>%
  mutate(pct.race = round(count / sum(count) * 100, 2)) %>%
  ungroup() %>%
  filter(race == "B")

dc_race <- project3.race %>%
  filter(statecity == "DC-Washington") %>%
  pull(pct.race)

project3.race <- project3.race %>%
  mutate(diff = abs(pct.race - dc_race)) %>%
  arrange(diff) %>%
  mutate(rank.race = row_number() - 1)

# mental illness
project3.mental <- project3 %>%
  group_by(statecity, was_mental_illness_related) %>%
  summarise(count = n(), .groups = "drop_last") %>%
  mutate(pct.mental = round(count / sum(count) * 100, 2)) %>%
  ungroup() %>%
  filter(was_mental_illness_related == "False")

dc_mental <- project3.mental %>%
  filter(statecity == "DC-Washington") %>%
  pull(pct.mental)

project3.mental <- project3.mental %>%
  mutate(diff = abs(pct.mental - dc_mental)) %>%
  arrange(diff) %>%
  mutate(rank.mental = row_number() - 1)

# body camera
project3.camera <- project3 %>%
  group_by(statecity, body_camera) %>%
  summarise(count = n(), .groups = "drop_last") %>%
  mutate(pct.camera = round(count / sum(count) * 100, 2)) %>%
  ungroup() %>%
  filter(body_camera == "False")

dc_camera <- project3.camera %>%
  filter(statecity == "DC-Washington") %>%
  pull(pct.camera)

project3.camera <- project3.camera %>%
  mutate(diff = abs(pct.camera - dc_camera)) %>%
  arrange(diff) %>%
  mutate(rank.camera = row_number() - 1)

# Step 6: Merge ranking tables
sub.events <- project3.events %>% select(statecity, count, rank.event)
sub.flee <- project3.flee %>% select(statecity, pct.flee, rank.flee)
sub.armed <- project3.armed %>% select(statecity, pct.armed, rank.armed)
sub.gender <- project3.gender %>% select(statecity, pct.gender, rank.gender)
sub.race <- project3.race %>% select(statecity, pct.race, rank.race)
sub.mental <- project3.mental %>% select(statecity, pct.mental, rank.mental)
sub.camera <- project3.camera %>% select(statecity, pct.camera, rank.camera)

project3.combined <- list(
  sub.events,
  sub.flee,
  sub.armed,
  sub.gender,
  sub.race,
  sub.mental,
  sub.camera
) %>% reduce(full_join, by = "statecity")

kable(project3.combined)
statecity count rank.event pct.flee rank.flee pct.armed rank.armed pct.gender rank.gender pct.race rank.race pct.mental rank.mental pct.camera rank.camera
DC-Washington 30 0 50.00 1 56.67 0 86.67 0 90.00 0 83.33 1 53.33 0
TN-Memphis 30 1 26.67 33 63.33 11 93.33 8 80.00 3 93.33 25 90.00 31
NC-Charlotte 29 2 65.52 29 72.41 28 93.10 6 55.17 12 65.52 33 72.41 17
OR-Portland 31 3 45.16 13 45.16 19 100.00 32 19.35 26 77.42 15 96.77 32
CA-Long Beach 27 4 62.96 25 40.74 29 81.48 3 25.93 22 88.89 13 77.78 24
MD-Baltimore 33 5 63.64 26 69.70 21 100.00 30 96.97 2 84.85 5 51.52 1
MI-Detroit 33 6 60.61 23 66.67 17 93.94 9 54.55 14 69.70 31 75.76 20
TX-Dallas 27 7 59.26 20 77.78 32 96.30 18 40.74 19 92.59 21 66.67 11
TX-El Paso 27 8 48.15 11 48.15 14 96.30 19 7.41 34 81.48 6 100.00 34
WI-Milwaukee 27 9 44.44 15 81.48 34 100.00 34 70.37 7 81.48 7 44.44 9
CA-San Francisco 26 10 76.92 34 42.31 24 92.31 5 19.23 27 76.92 16 57.69 3
CA-San Jose 26 11 69.23 31 42.31 25 96.15 17 7.69 33 69.23 32 76.92 21
KY-Louisville 37 12 56.76 16 59.46 3 97.30 22 37.84 21 89.19 14 45.95 7
CA-San Diego 38 13 55.26 14 42.11 27 97.37 23 18.42 28 71.05 27 36.84 14
TN-Nashville 20 14 65.00 28 65.00 13 95.00 13 50.00 17 70.00 30 45.00 8
MO-Kansas City 42 15 50.00 3 73.81 31 95.24 14 54.76 13 90.48 17 97.62 33
PA-Philadelphia 42 16 50.00 5 61.90 8 100.00 33 64.29 9 90.48 18 80.95 27
WA-Seattle 18 17 38.89 24 44.44 20 94.44 11 44.44 18 83.33 2 38.89 12
IN-Indianapolis 44 18 43.18 17 70.45 23 97.73 24 72.73 5 84.09 3 50.00 2
OH-Cleveland 16 19 50.00 4 81.25 33 100.00 31 87.50 1 81.25 8 68.75 13
MN-Minneapolis 15 20 66.67 30 60.00 5 93.33 7 66.67 8 80.00 9 46.67 6
CA-Oakland 14 21 64.29 27 64.29 12 100.00 28 50.00 16 92.86 22 78.57 25
OK-Oklahoma City 47 22 51.06 9 65.96 15 95.74 16 40.43 20 78.72 11 59.57 5
TX-Austin 48 23 60.42 22 66.67 18 91.67 2 14.58 30 70.83 29 62.50 10
MA-Boston 10 24 50.00 2 70.00 22 100.00 29 60.00 11 60.00 34 80.00 26
OH-Columbus 51 25 56.86 18 60.78 6 92.16 4 62.75 10 92.16 20 70.59 16
AZ-Tucson 54 26 51.85 10 62.96 10 98.15 25 11.11 31 83.33 0 87.04 29
CO-Denver 56 27 50.00 0 58.93 2 91.07 1 19.64 25 92.86 23 89.29 30
IL-Chicago 57 28 29.82 32 73.68 30 96.49 20 77.19 4 92.98 24 73.68 19
NY-New York 77 29 50.65 8 58.44 1 98.70 26 71.43 6 72.73 26 70.13 15
NV-Las Vegas 86 30 59.30 21 61.63 7 96.51 21 25.58 23 70.93 28 58.14 4
TX-San Antonio 101 31 50.50 7 66.34 16 94.06 10 9.90 32 91.09 19 77.23 23
TX-Houston 125 32 46.40 12 71.20 26 99.20 27 50.40 15 82.40 4 73.60 18
AZ-Phoenix 130 33 56.92 19 60.00 4 95.38 15 16.92 29 88.46 12 81.54 28
CA-Los Angeles 157 34 49.68 6 50.96 9 94.90 12 22.29 24 87.26 10 77.07 22 
# Optional column reordering
test <- project3.combined[c(1:10, 13, 11, 12)]
kable(test)
statecity count rank.event pct.flee rank.flee pct.armed rank.armed pct.gender rank.gender pct.race rank.mental rank.race pct.mental
DC-Washington 30 0 50.00 1 56.67 0 86.67 0 90.00 1 0 83.33
TN-Memphis 30 1 26.67 33 63.33 11 93.33 8 80.00 25 3 93.33
NC-Charlotte 29 2 65.52 29 72.41 28 93.10 6 55.17 33 12 65.52
OR-Portland 31 3 45.16 13 45.16 19 100.00 32 19.35 15 26 77.42
CA-Long Beach 27 4 62.96 25 40.74 29 81.48 3 25.93 13 22 88.89
MD-Baltimore 33 5 63.64 26 69.70 21 100.00 30 96.97 5 2 84.85
MI-Detroit 33 6 60.61 23 66.67 17 93.94 9 54.55 31 14 69.70
TX-Dallas 27 7 59.26 20 77.78 32 96.30 18 40.74 21 19 92.59
TX-El Paso 27 8 48.15 11 48.15 14 96.30 19 7.41 6 34 81.48
WI-Milwaukee 27 9 44.44 15 81.48 34 100.00 34 70.37 7 7 81.48
CA-San Francisco 26 10 76.92 34 42.31 24 92.31 5 19.23 16 27 76.92
CA-San Jose 26 11 69.23 31 42.31 25 96.15 17 7.69 32 33 69.23
KY-Louisville 37 12 56.76 16 59.46 3 97.30 22 37.84 14 21 89.19
CA-San Diego 38 13 55.26 14 42.11 27 97.37 23 18.42 27 28 71.05
TN-Nashville 20 14 65.00 28 65.00 13 95.00 13 50.00 30 17 70.00
MO-Kansas City 42 15 50.00 3 73.81 31 95.24 14 54.76 17 13 90.48
PA-Philadelphia 42 16 50.00 5 61.90 8 100.00 33 64.29 18 9 90.48
WA-Seattle 18 17 38.89 24 44.44 20 94.44 11 44.44 2 18 83.33
IN-Indianapolis 44 18 43.18 17 70.45 23 97.73 24 72.73 3 5 84.09
OH-Cleveland 16 19 50.00 4 81.25 33 100.00 31 87.50 8 1 81.25
MN-Minneapolis 15 20 66.67 30 60.00 5 93.33 7 66.67 9 8 80.00
CA-Oakland 14 21 64.29 27 64.29 12 100.00 28 50.00 22 16 92.86
OK-Oklahoma City 47 22 51.06 9 65.96 15 95.74 16 40.43 11 20 78.72
TX-Austin 48 23 60.42 22 66.67 18 91.67 2 14.58 29 30 70.83
MA-Boston 10 24 50.00 2 70.00 22 100.00 29 60.00 34 11 60.00
OH-Columbus 51 25 56.86 18 60.78 6 92.16 4 62.75 20 10 92.16
AZ-Tucson 54 26 51.85 10 62.96 10 98.15 25 11.11 0 31 83.33
CO-Denver 56 27 50.00 0 58.93 2 91.07 1 19.64 23 25 92.86
IL-Chicago 57 28 29.82 32 73.68 30 96.49 20 77.19 24 4 92.98
NY-New York 77 29 50.65 8 58.44 1 98.70 26 71.43 26 6 72.73
NV-Las Vegas 86 30 59.30 21 61.63 7 96.51 21 25.58 28 23 70.93
TX-San Antonio 101 31 50.50 7 66.34 16 94.06 10 9.90 19 32 91.09
TX-Houston 125 32 46.40 12 71.20 26 99.20 27 50.40 4 15 82.40
AZ-Phoenix 130 33 56.92 19 60.00 4 95.38 15 16.92 12 29 88.46
CA-Los Angeles 157 34 49.68 6 50.96 9 94.90 12 22.29 10 24 87.26 
# Step 7: Example tables
project3.combined %>%
  arrange(rank.event) %>%
  head(10) %>%
  kable()
statecity count rank.event pct.flee rank.flee pct.armed rank.armed pct.gender rank.gender pct.race rank.race pct.mental rank.mental pct.camera rank.camera
DC-Washington 30 0 50.00 1 56.67 0 86.67 0 90.00 0 83.33 1 53.33 0
TN-Memphis 30 1 26.67 33 63.33 11 93.33 8 80.00 3 93.33 25 90.00 31
NC-Charlotte 29 2 65.52 29 72.41 28 93.10 6 55.17 12 65.52 33 72.41 17
OR-Portland 31 3 45.16 13 45.16 19 100.00 32 19.35 26 77.42 15 96.77 32
CA-Long Beach 27 4 62.96 25 40.74 29 81.48 3 25.93 22 88.89 13 77.78 24
MD-Baltimore 33 5 63.64 26 69.70 21 100.00 30 96.97 2 84.85 5 51.52 1
MI-Detroit 33 6 60.61 23 66.67 17 93.94 9 54.55 14 69.70 31 75.76 20
TX-Dallas 27 7 59.26 20 77.78 32 96.30 18 40.74 19 92.59 21 66.67 11
TX-El Paso 27 8 48.15 11 48.15 14 96.30 19 7.41 34 81.48 6 100.00 34
WI-Milwaukee 27 9 44.44 15 81.48 34 100.00 34 70.37 7 81.48 7 44.44 9 
# Step 8: Maps
world <- ne_countries(scale = "medium", returnclass = "sf")
states <- st_as_sf(maps::map("state", plot = FALSE, fill = TRUE))

# Transparent point map
ggplot(data = world) + 
  geom_sf() + 
  geom_sf(data = states, fill = NA) + 
  geom_point(
    data = wapo.data.map,
    aes(x = longitude, y = latitude),
    size = 2,
    alpha = 0.05
  ) + 
  coord_sf(xlim = c(-135, -60), ylim = c(25, 50), expand = FALSE)

# Facet by year
ggplot(data = world) + 
  geom_sf() + 
  geom_sf(data = states, fill = NA) + 
  geom_point(
    data = wapo.data.map,
    aes(x = longitude, y = latitude),
    size = 2,
    alpha = 0.05
  ) + 
  coord_sf(xlim = c(-135, -60), ylim = c(25, 50), expand = FALSE) + 
  facet_wrap(~ year, nrow = 3)

# Facet by race
ggplot(data = world) + 
  geom_sf() + 
  geom_sf(data = states, fill = NA) + 
  geom_point(
    data = wapo.data.map,
    aes(x = longitude, y = latitude),
    size = 2,
    alpha = 0.05
  ) + 
  coord_sf(xlim = c(-135, -60), ylim = c(25, 50), expand = FALSE) + 
  facet_wrap(~ race, nrow = 3)

# Hex map for all data
ggplot(data = world) + 
  geom_sf() + 
  geom_sf(data = states, fill = NA) + 
  geom_hex(
    aes(x = longitude, y = latitude),
    data = wapo.data.map,
    bins = 45,
    alpha = 0.6
  ) + 
  scale_fill_continuous(type = "viridis") + 
  coord_sf(xlim = c(-135, -60), ylim = c(25, 50), expand = FALSE)

# Hex map for just the 35 project cities
ggplot(data = world) + 
  geom_sf() + 
  geom_sf(data = states, fill = NA) + 
  geom_hex(
    aes(x = longitude, y = latitude),
    data = project3,
    bins = 25,
    alpha = 0.6
  ) + 
  scale_fill_continuous(type = "viridis") + 
  coord_sf(xlim = c(-135, -60), ylim = c(25, 50), expand = FALSE)

# Interactive map
leaflet(wapo.data.map) %>%
  addTiles() %>%
  addMarkers(
    lng = ~longitude,
    lat = ~latitude,
    clusterOptions = markerClusterOptions()
  )

Analysis

Finding and Data

The three cities most similar to Washington D.C. in Police Shootings are Memphis, Charlotte, and Portland. This is primarily due to the close similarity in event count these 4 cities have when it comes to the number of police shootings since 2015, however they differ slightly when it comes to variables such as race, gender, mental illness, etc. What gave way to this finding was through the statistics found in ‘Mapping Police Violence’s’ data of police shootings across the country. Specific statistics used include the number of shootings in a city, victims’ gender and race, whether they tried to flee or were armed, and if they were affected by any kind of mental illness. With these statistics I was able to come to this finding.

Memphis, TN

The first city being analyzed will be Memphis, Tennessee. Memphis is most similar to D.C. in the total amount of events, with both sharing an event count of 30. Both cities share a similar gender distribution. Washington, D.C. finds itself with a 90% male victim demographic in police shootings. Memphis, meanwhile, has a slightly higher percentage at 93%. The gap in similarities begins to grow slowly when compared to other variables. 63.33% of Memphis police shooting victims were carrying weapons, where D.C. has a smaller 56.67% of victims being armed. For mental illness being related to the victim, 93.33% of Memphis victims were affected by some sort of mental illness, with D.C. slightly behind at 83.33%. For the final variable, the similarity between D.C. and Memphis is much smaller compared to the others. Body camera footage was lacking in 90% of the events in Memphis, compared to D.C.’s 53.33%. The similarities between Washington D.C. and Memphis are quite substantial considering how similar they are even when having a 1:1 event count.

## DC vs Memphis

Charlotte, NC

The second most similar city I found to Washington, D.C. was Charlotte, North Carolina. Second in rank behind Memphis, Charlotte has had 29 recorded events of police shootings compared to D.C.’s 30. The variable Charlotte is most similar to D.C. is fleeing status of victims, with Charlotte at 65.52% of victims not attempting to flee while D.C. is at 50% exactly. After that, looking at race is the next similarity, with 55.17% of victims being black in Charlotte compared to D.C’s 90%. The next similarity is gender, with 93.10% of victims being male in Charlotte compared to D.C.’s 86.67%. With these similar variables it shows how D.C. and Charlotte have similarities when it comes to the race and gender demographics of its victims, but the difference in race is much grander than it is with gender and some of the actions of the victims in Charlotte.

## Washington, DC vs Charlotte

Baltimore, MD