Permalink
Switch branches/tags
Nothing to show
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
563 lines (324 sloc) 19.4 KB
title author date output
officer options
Andrew Ba Tran
May 26, 2016
html_document
knitr::opts_chunk$set(echo = TRUE)
knitr::opts_chunk$set(cache=TRUE)

#Exploring different ways to visualize traffic data for individual police officers.

library(ggplot2)
library(dplyr)
library(tidyr)
library(ggalt)
explore <- read.csv("data/mega_df.csv")

single_dept <- subset(explore, DepartmentName=="Waterbury" & is.na(ReportingOfficerIdentificationID))
single_officer <- subset(explore, DepartmentName=="Waterbury" & ReportingOfficerIdentificationID=="Waterbury--2103")
single_all <- subset(explore, DepartmentName=="Connecticut average"  & is.na(ReportingOfficerIdentificationID))

dept_name <- paste0(single_dept$DepartmentName[1], " Police | Traffic Stops")

r paste0("Officer: ", single_officer$ReportingOfficerIdentificationID[1])

r paste0(single_dept$DepartmentName[1], " Police | Traffic Stops")

r paste0(single_officer$min_p[1], " percent of drivers stopped by Officer ", single_officer$ReportingOfficerIdentificationID[1], " were minorities, compared with ", single_dept$DepartmentName[1], "'s ", single_dept$min_p[1], " percent and state's ", single_all$min_p[1], " percent statewide.")


stops_race1 <- single_dept %>%
  select(DepartmentName, asian_p, black_p, hispanic_p, indian_p, mid_e_p, white_p) %>%
  gather("Ethnicity", "Percent", 2:7)

stops_race2 <- single_all %>%
  select(DepartmentName, asian_p, black_p, hispanic_p, indian_p, mid_e_p, white_p) %>%
  gather("Ethnicity", "Percent", 2:7)  

stops_race2$DepartmentName <- gsub("Connecticut average", "Connecticut", stops_race2$DepartmentName)


stops_race3 <- single_officer %>%
  select(ReportingOfficerIdentificationID, asian_p, black_p, hispanic_p, indian_p, mid_e_p, white_p) %>%
  gather("Ethnicity", "Percent", 2:7)


names(stops_race3)[names(stops_race3) == 'ReportingOfficerIdentificationID'] <- 'DepartmentName'


stops_race <- rbind(stops_race1, stops_race2)
stops_race <- rbind(stops_race, stops_race3)





stops_race$Ethnicity <- gsub("asian_p", "Asian", stops_race$Ethnicity)
stops_race$Ethnicity <- gsub("black_p", "Black", stops_race$Ethnicity)
stops_race$Ethnicity <- gsub("hispanic_p", "Hispanic", stops_race$Ethnicity)
stops_race$Ethnicity <- gsub("indian_p", "Indian", stops_race$Ethnicity)
stops_race$Ethnicity <- gsub("mid_e_p", "Middle-Eastern", stops_race$Ethnicity)
stops_race$Ethnicity <- gsub("white_p", "White", stops_race$Ethnicity)

ggplot(stops_race, aes(Ethnicity, Percent, fill = DepartmentName, label = Percent)) +
  geom_bar(stat = "identity", position = "dodge") +
  geom_text(position = position_dodge(0.9), vjust = -0.5, size=3) + labs(title="Traffic stops in 2014 by race percent")

#ggplot(stops_race, aes(x=DepartmentName, y=Percent)) + geom_bar(aes(fill=Ethnicity), stat="identity") +
#  geom_text(aes(label=Percent, y=pos), size=3) + coord_flip() + labs(title="Traffic stops in 2014")

r paste0(single_dept$minorities_p[1], " % NON-WHITE")

The driving-age population is r single_dept$minorities_p[1] percent minority in r single_dept$DepartmentName[1] and r single_all$minorities_p[1] minority statewide.


Gender

For officer r single_officer$ReportingOfficerIdentificationID[1]

  • r single_officer$male_p[1] percent were men
  • r single_officer$female_p[1] were women

In r single_dept$DepartmentName[1]

  • r single_dept$male_p[1] percent were men
  • r single_dept$female_p[1] were women

Statewide

  • r single_all$male_p[1] percent were men
  • r single_all$female_p[1] were women

The median age for drivers stopped by officer r single_officer$ReportingOfficerIdentificationID[1] was r single_officer$median_age[1] versus r single_dept$median_age[1] in r single_dept$DepartmentName[1] and r single_all$median_age[1] years old statewide.


stops_age1 <- single_dept %>%
  select(DepartmentName, y16_21_p, y22_27_p, y28_31_p, y32_37_p, y38_41_p, y42_47_p, y48_51_p, y52_57_p, y58_61_p, y62_67_p, y68_71_p, y72_77_p, y78_81_p, y82_p) %>%
  gather("Age", "Percent", 2:15)  

stops_age2 <- single_all %>%
  select(DepartmentName, y16_21_p, y22_27_p, y28_31_p, y32_37_p, y38_41_p, y42_47_p, y48_51_p, y52_57_p, y58_61_p, y62_67_p, y68_71_p, y72_77_p, y78_81_p, y82_p) %>%
  gather("Age", "Percent", 2:15) 

stops_age2$DepartmentName <- gsub("Connecticut average", "Connecticut", stops_age2$DepartmentName)

stops_age3 <- single_officer %>%
  select(ReportingOfficerIdentificationID, y16_21_p, y22_27_p, y28_31_p, y32_37_p, y38_41_p, y42_47_p, y48_51_p, y52_57_p, y58_61_p, y62_67_p, y68_71_p, y72_77_p, y78_81_p, y82_p) %>%
  gather("Age", "Percent", 2:15) 

names(stops_age3)[names(stops_age3) == 'ReportingOfficerIdentificationID'] <- 'DepartmentName'


stops_age <- rbind(stops_age1, stops_age2)
stops_age <- rbind(stops_age, stops_age3)


stops_age$Age <- gsub("y", "", stops_age$Age)
stops_age$Age <- gsub("_", "-", stops_age$Age)
stops_age$Age <- gsub("-p", "", stops_age$Age)
stops_age$Age <- gsub("82", "82+", stops_age$Age)

ggplot(stops_age, aes(Age, Percent, fill = DepartmentName, label = Percent)) +
  geom_bar(stat = "identity", position = "dodge") +
  geom_text(position = position_dodge(0.9), vjust = -0.5, size=3) + labs(title="Traffic stops in 2014 by age group percent")


When


stops_day1 <- single_officer %>%
  select(ReportingOfficerIdentificationID, Sun, Mon, Tues, Wed, Thurs, Fri, Sat) %>%
  gather("Day", "Percent", 2:8)  

stops_day <- stops_day1
stops_day$Day <- factor(stops_day$Day, levels= c("Sun", "Mon", 
    "Tues", "Wed", "Thurs", "Fri", "Sat"))

ggplot(stops_day, aes(Day, Percent, fill = ReportingOfficerIdentificationID, label = Percent)) +
  geom_bar(stat = "identity", position = "dodge") +
  geom_text(position = position_dodge(0.9), vjust = -0.5, size=3) + labs(title="Days when drivers were stopped") 


stops_reason1 <- single_dept %>%
  select(DepartmentName, DefectiveLights_p, DisplayofPlates_p, EquipmentViolation_p, MovingViolation_p, Other_p, Registration_p, Seatbelt_p, SpeedRelated_p, StopSign_p, SuspendedLicense_p,TrafficControlSignal_p,
WindowTint_p) %>%
  gather("Reason", "Percent", 2:13)  

stops_reason2 <- single_all %>%  
  select(DepartmentName, DefectiveLights_p, DisplayofPlates_p, EquipmentViolation_p, MovingViolation_p, Other_p, Registration_p, Seatbelt_p, SpeedRelated_p, StopSign_p, SuspendedLicense_p,TrafficControlSignal_p,
WindowTint_p) %>%
  gather("Reason", "Percent", 2:13)  

stops_reason2$DepartmentName <- gsub("Connecticut average", "Connecticut", stops_reason2$DepartmentName)


stops_reason3 <- single_officer %>%  
  select(ReportingOfficerIdentificationID, DefectiveLights_p, DisplayofPlates_p, EquipmentViolation_p, MovingViolation_p, Other_p, Registration_p, Seatbelt_p, SpeedRelated_p, StopSign_p, SuspendedLicense_p,TrafficControlSignal_p,
WindowTint_p) %>%
  gather("Reason", "Percent", 2:13)  


names(stops_reason3)[names(stops_reason3) == 'ReportingOfficerIdentificationID'] <- 'DepartmentName'


stops_reason <- rbind(stops_reason1, stops_reason2)
stops_reason <- rbind(stops_reason, stops_reason3)

stops_reason$Reason <- gsub("_p", "", stops_reason$Reason)

ggplot(stops_reason, aes(Reason, Percent, fill = DepartmentName, label = Percent)) +
  geom_bar(stat = "identity", position = "dodge") +
  geom_text(position = position_dodge(0.9), hjust = -0.2, size=3) + labs(title="Reasons for traffic stops") + coord_flip()


After traffic stops


stops_result1 <- single_dept %>%
  select(DepartmentName, infraction_ticket_p, misdemeanor_summons_p, no_disposition_p, uniform_arrest_p, verbal_warning_p, written_warning_p) %>%
  gather("Result", "Percent", 2:7)  


stops_result2 <- single_all %>%
  select(DepartmentName, infraction_ticket_p, misdemeanor_summons_p, no_disposition_p, uniform_arrest_p, verbal_warning_p, written_warning_p) %>%
  gather("Result", "Percent", 2:7)  

stops_result2$DepartmentName <- gsub("Connecticut average", "Connecticut", stops_result2$DepartmentName)


stops_result3 <- single_officer %>%
  select(ReportingOfficerIdentificationID, infraction_ticket_p, misdemeanor_summons_p, no_disposition_p, uniform_arrest_p, verbal_warning_p, written_warning_p) %>%
  gather("Result", "Percent", 2:7)  

names(stops_result3)[names(stops_result3) == 'ReportingOfficerIdentificationID'] <- 'DepartmentName'


stops_result <- rbind(stops_result1, stops_result2)
stops_result <- rbind(stops_result, stops_result3)

stops_result$Result <- gsub("_p", "", stops_result$Result)


ggplot(stops_result, aes(Result, Percent, fill = DepartmentName, label = Percent)) +
  geom_bar(stat = "identity", position = "dodge") +
  geom_text(position = position_dodge(0.9), vjust = -0.5, size=3) + labs(title="Result after traffic stops") 


Searches

r single_dept$DepartmentName[1] officers searched r single_dept$searched_p[1] percent of drivers they stopped. r single_officer$ReportingOfficerIdentificationID[1] searched r single_officer$searched_p[1] percent.

This chart shows the percentage of all stops involving searches of cars driven by white or non-white drivers.


stops_search1 <- single_dept %>%
  select(DepartmentName, Minority.x, White.y) %>%
  gather("Searched", "Percent", 2:3)  


stops_search2 <- single_all %>%
  select(DepartmentName, Minority.x, White.y) %>%
  gather("Searched", "Percent", 2:3)  


stops_search2$DepartmentName <- gsub("Connecticut average", "Connecticut", stops_search2$DepartmentName)

stops_search3 <- single_officer %>%
  select(ReportingOfficerIdentificationID, Minority.x, White.y) %>%
  gather("Searched", "Percent", 2:3)  

names(stops_search3)[names(stops_search3) == 'ReportingOfficerIdentificationID'] <- 'DepartmentName'

stops_search <- rbind(stops_search1, stops_search2)
stops_search <- rbind(stops_search, stops_search3)


stops_search$Searched <- gsub(".x", "", stops_search$Searched)
stops_search$Searched <- gsub(".y", "", stops_search$Searched)

ggplot(stops_search, aes(Searched, Percent, fill = DepartmentName, label = Percent)) +
  geom_bar(stat = "identity", position = "dodge") +
  geom_text(position = position_dodge(0.9), vjust = -0.5, size=3) + labs(title="Who was searched") 


Residential stops

For officer r single_officer$ReportingOfficerIdentificationID[1]

  • r single_officer$resident_p[1] percent were residents
  • r single_officer$not.resident_p[1] were non-residents

In r single_dept$DepartmentName[1]

  • r single_dept$resident_p[1] percent were residents
  • r single_dept$not.resident_p[1] were non-residents

Statewide

  • r single_all$resident_p[1] percent were men
  • r single_all$not.resident_p[1] were women

Black drivers: Of those stopped, how many were residents or non-residents?


stops_res_min1 <- single_dept %>%
  select(DepartmentName, not.resident_b_p, resident_b_p) %>%
  gather("Status", "Percent", 2:3)  


stops_res_min2 <- single_all %>%
  select(DepartmentName, not.resident_b_p, resident_b_p) %>%
  gather("Status", "Percent", 2:3)  


stops_res_min2$DepartmentName <- gsub("Connecticut average", "Connecticut", stops_res_min2$DepartmentName)

stops_res_min3 <- single_officer %>%
  select(ReportingOfficerIdentificationID, not.resident_b_p, resident_b_p) %>%
  gather("Status", "Percent", 2:3)  


names(stops_res_min3)[names(stops_res_min3) == 'ReportingOfficerIdentificationID'] <- 'DepartmentName'

stops_res_min <- rbind(stops_res_min1, stops_res_min2)
stops_res_min <- rbind(stops_res_min, stops_res_min3)

stops_res_min$Status <- gsub("_p", "", stops_res_min$Status)

ggplot(stops_res_min, aes(Status, Percent, fill = DepartmentName, label = Percent)) +
  geom_bar(stat = "identity", position = "dodge") +
  geom_text(position = position_dodge(0.9), vjust = -0.5, size=3) + labs(title="Black residents pulled over") 


Hispanic drivers: Of those stopped, how many were residents or non-residents?


stops_res_min1 <- single_dept %>%
  select(DepartmentName, not.resident_h_p, resident_h_p) %>%
  gather("Status", "Percent", 2:3)  


stops_res_min2 <- single_all %>%
  select(DepartmentName, not.resident_h_p, resident_h_p) %>%
  gather("Status", "Percent", 2:3)  


stops_res_min2$DepartmentName <- gsub("Connecticut average", "Connecticut", stops_res_min2$DepartmentName)


stops_res_min3 <- single_officer %>%
  select(ReportingOfficerIdentificationID, not.resident_h_p, resident_h_p) %>%
  gather("Status", "Percent", 2:3)  

names(stops_res_min3)[names(stops_res_min3) == 'ReportingOfficerIdentificationID'] <- 'DepartmentName'

stops_res_min <- rbind(stops_res_min1, stops_res_min2)
stops_res_min <- rbind(stops_res_min, stops_res_min3)

stops_res_min$Status <- gsub("_p", "", stops_res_min$Status)

ggplot(stops_res_min, aes(Status, Percent, fill = DepartmentName, label = Percent)) +
  geom_bar(stat = "identity", position = "dodge") +
  geom_text(position = position_dodge(0.9), vjust = -0.5, size=3) + labs(title="Hispanic residents pulled over") 


Non-white drivers: Of those stopped, how many were residents or non-residents?


stops_res_min1 <- single_dept %>%
  select(DepartmentName, not.resident_m_p, resident_m_p) %>%
  gather("Status", "Percent", 2:3)  


stops_res_min2 <- single_all %>%
  select(DepartmentName, not.resident_m_p, resident_m_p) %>%
  gather("Status", "Percent", 2:3)  


stops_res_min2$DepartmentName <- gsub("Connecticut average", "Connecticut", stops_res_min2$DepartmentName)

stops_res_min3 <- single_officer %>%
  select(ReportingOfficerIdentificationID, not.resident_m_p, resident_m_p) %>%
  gather("Status", "Percent", 2:3)  

names(stops_res_min3)[names(stops_res_min3) == 'ReportingOfficerIdentificationID'] <- 'DepartmentName'


stops_res_min <- rbind(stops_res_min1, stops_res_min2)
stops_res_min <- rbind(stops_res_min, stops_res_min3)

stops_res_min$Status <- gsub("_p", "", stops_res_min$Status)

ggplot(stops_res_min, aes(Status, Percent, fill = DepartmentName, label = Percent)) +
  geom_bar(stat = "identity", position = "dodge") +
  geom_text(position = position_dodge(0.9), vjust = -0.5, size=3) + labs(title="Minority residents pulled over") 


Type of stops


stops_ser_min1 <- single_dept %>%
  select(DepartmentName, general.enforcement_p, blind.enforcement_p, spot.check_p) %>%
  gather("Stops", "Percent", 2:4)  


stops_ser_min2 <- single_all %>%
  select(DepartmentName, general.enforcement_p, blind.enforcement_p, spot.check_p) %>%
  gather("Stops", "Percent", 2:4)  


stops_ser_min2$DepartmentName <- gsub("Connecticut average", "Connecticut", stops_ser_min2$DepartmentName)


stops_ser_min3 <- single_officer %>%
  select(ReportingOfficerIdentificationID, general.enforcement_p, blind.enforcement_p, spot.check_p) %>%
  gather("Stops", "Percent", 2:4)  

names(stops_ser_min3)[names(stops_ser_min3) == 'ReportingOfficerIdentificationID'] <- 'DepartmentName'

stops_ser_min <- rbind(stops_ser_min1, stops_ser_min2)
stops_ser_min <- rbind(stops_ser_min, stops_ser_min3)

stops_ser_min$Stops <- gsub("_p", "", stops_ser_min$Stops)

ggplot(stops_ser_min, aes(Stops, Percent, fill = DepartmentName, label = Percent)) +
  geom_bar(stat = "identity", position = "dodge") +
  geom_text(position = position_dodge(0.9), vjust = -0.5, size=3) + labs(title="Percent of type of stops out of all stops") 


Spot checks


stops_ser_min1 <- single_dept %>%
  select(DepartmentName, Minority.y, White.x.1) %>%
  gather("Stops", "Percent", 2:3)  


stops_ser_min2 <- single_all %>%
  select(DepartmentName, Minority.y, White.x.1) %>%
  gather("Stops", "Percent", 2:3)  



stops_ser_min2$DepartmentName <- gsub("Connecticut average", "Connecticut", stops_ser_min2$DepartmentName)

stops_ser_min3 <- single_officer %>%
  select(ReportingOfficerIdentificationID, Minority.y, White.x.1) %>%
  gather("Stops", "Percent", 2:3)  

names(stops_ser_min3)[names(stops_ser_min3) == 'ReportingOfficerIdentificationID'] <- 'DepartmentName'

stops_ser_min <- rbind(stops_ser_min1, stops_ser_min2)
stops_ser_min <- rbind(stops_ser_min, stops_ser_min3)


stops_ser_min$Stops <- gsub("_p", "", stops_ser_min$Stops)

ggplot(stops_ser_min, aes(Stops, Percent, fill = DepartmentName, label = Percent)) +
  geom_bar(stat = "identity", position = "dodge") +
  geom_text(position = position_dodge(0.9), vjust = -0.5, size=3) + labs(title="Percent of spot checks for minorities out of total stops") 

Blind enforcement


stops_ser_min1 <- single_dept %>%
  select(DepartmentName, Minority, White.y.1) %>%
  gather("Stops", "Percent", 2:3)  


stops_ser_min2 <- single_all %>%
  select(DepartmentName, Minority, White.y.1) %>%
  gather("Stops", "Percent", 2:3)  



stops_ser_min2$DepartmentName <- gsub("Connecticut average", "Connecticut", stops_ser_min2$DepartmentName)

stops_ser_min3 <- single_officer %>%
  select(ReportingOfficerIdentificationID, Minority, White.y.1) %>%
  gather("Stops", "Percent", 2:3)  

names(stops_ser_min3)[names(stops_ser_min3) == 'ReportingOfficerIdentificationID'] <- 'DepartmentName'

stops_ser_min <- rbind(stops_ser_min1, stops_ser_min2)
stops_ser_min <- rbind(stops_ser_min, stops_ser_min3)

stops_ser_min$Stops <- gsub("_p", "", stops_ser_min$Stops)

ggplot(stops_ser_min, aes(Stops, Percent, fill = DepartmentName, label = Percent)) +
  geom_bar(stat = "identity", position = "dodge") +
  geom_text(position = position_dodge(0.9), vjust = -0.5, size=3) + labs(title="Percent of blind enforcement for minorities out of total stops") 

About r single_dept$DepartmentName[1]

  • Number of employees in department: r single_dept$total_leo[1] (r single_dept$leo_per_capita[1] per 10,000 residents)
  • Number of officers: r single_dept$total_officers[1] (r single_dept$officers_per_capita[1] per 10,000 residents)
  • Number of civilian workers: r single_dept$total_civilians[1] (r single_dept$civ_per_capita[1] per 10,000 residents)

stops_reason1 <- single_dept %>%
  select(DepartmentName, violent_crime_pc, murder_manslaughter_pc, rape_pc, robbery_pc, aggravated_robbery_pc, property_crime_pc, burglary_pc, larceny_theft_pc, motor_vehicle_theft_pc, arson_pc) %>%
  gather("Crime", "Percent", 2:11)  

stops_reason2 <- single_all %>%  
  select(DepartmentName, violent_crime_pc, murder_manslaughter_pc, rape_pc, robbery_pc, aggravated_robbery_pc, property_crime_pc, burglary_pc, larceny_theft_pc, motor_vehicle_theft_pc, arson_pc) %>%
  gather("Crime", "Percent", 2:11)  

stops_reason2$DepartmentName <- gsub("Connecticut average", "Connecticut", stops_reason2$DepartmentName)

stops_reason <- rbind(stops_reason1, stops_reason2)
stops_reason$Crime <- gsub("_pc", "", stops_reason$Crime)

ggplot(stops_reason, aes(Crime, Percent, fill = DepartmentName, label = Percent)) +
  geom_bar(stat = "identity", position = "dodge") +
  geom_text(position = position_dodge(0.9), hjust = -0.2, size=3) + labs(title="Crime per 10,000 residents") + coord_flip()