Introduction

This is an R Markdown descriptive report on the activity of the Seattle Police Department (SPD) with regards to priority responses to calls. With the recent movements of Defund the Police and Blue Lives Matter turning police departments into an emotionally triggering political topic, I would like to step back and look at what the data reflects. By addressing the current and historical state of the SPD, we can better address the needs for allocating resources for future changes to the department - if necessary.

The Questions: - Is the SPD helpful? - What type of help could be expected from calling the SPD? - What does the SPD do most of the time? - Is the SPD reliable for emergencies? - How often is the SPD not helpful or reliable?

For more information on the department see https://www.seattle.gov/police.

Dataset

The Seattle Police Call Data set is 4.84 Million rows of police response records from August 2009- January 2022. This data was queried from the Data Analytics Platform and is updated daily. Each row is a record of a Call for Service (CfS) containing a unique CAD Event Number, priority, event type, call type, time stamps, and location of event. Rows may contain records of officers activity from observations in the field. Some priority events are specific to this activity and can be seen reflected in response times for sections of this R Markdown report.

The data set for this report can be found at https://data.seattle.gov/Public-Safety/Call-Data/33kz-ixgy?category=Public-Safety&view_name=Call-Data.

The data set structure:

min_one <- which(df$Priority == -1)
df <- df[-min_one,]

callcount <- data.frame(count(df, Sector))
callcount <- callcount[order(callcount$n,decreasing = TRUE),]


na_sectors <- which(is.na(df$Sector))
na_precinct <- which(df$Precinct %like% "UNKNOWN")


calls_no_location <- df[na_sectors]
calls_with_location <- df[-na_sectors]


df$year_queued <- year(mdy_hms(df$`Original Time Queued`))
df$year_arrived <- year(mdy_hms(df$`Arrived Time`))


calls1900 <- which(df$year_arrived %like% 1900)
a = df[-calls1900,]


a$`Original Time Queued` <- mdy_hms(a$`Original Time Queued`)
a$`Arrived Time` <- mdy_hms(a$`Arrived Time`)
a$response <- difftime(a$`Arrived Time`, a$`Original Time Queued`)
a$response <- as.duration(a$response)
a$response <- as.numeric(a$response)


all_events <- (df$`Event Clearance Description`)
unique_events <- data.frame(unique(all_events))

avg <- sum(a$response) / length(a$response)


pr <- a %>%
  select(Priority, response) %>%
  group_by(Priority) %>%
  summarise(i = mean(response)) %>%
  data.frame()
pr$imin <- pr$i/60

priority_df <- a %>%
  select(Priority) %>%
  group_by(Priority) %>%
  summarise(n=n())  %>%
  data.frame()

events <- df %>%
  select(`Event Clearance Description`) %>%
  group_by(`Event Clearance Description`) %>%
  summarise(n=n())  %>%
  data.frame()
top_ten <- events[order(events$n, decreasing = TRUE),]
top_ten <- top_ten[0:10,]
no_action <- events$Event.Clearance.Description[c(1,6,9, 12, 13, 26)]

cp_df <- a %>%
  filter(Priority %in% c(1,2,3))%>%
  filter(`Event Clearance Description` %in% top_ten$Event.Clearance.Description)%>%
  select(`Event Clearance Description`, response, Priority) %>%
  group_by(`Event Clearance Description`, Priority) %>%
  summarise(respond_seconds = mean(response), n=n(), .groups = 'keep')%>%
  data.frame()

cp_df$Priority <- as.factor(cp_df$Priority)
top_ten_events <- c(top_ten$Event.Clearance.Description)
event_order <- factor(cp_df$Event.Clearance.Description, level = top_ten_events)

no_response_list<- events$Event.Clearance.Description[c(1,2,6,9,12,13,22,26)]
response_list<-events$Event.Clearance.Description[-c(1,2,6,9,12,13,22,26)]

yes_response_df <- a %>%
  select(Priority, `Event Clearance Description`)%>%
  group_by(Priority)%>%
  summarise(n=sum(`Event Clearance Description` %in% response_list))%>%
  mutate(response = "yes")%>%
  data.frame()
no_response_df <- a %>%
  select(Priority, `Event Clearance Description`)%>%
  group_by(Priority)%>%
  summarise(n=sum(`Event Clearance Description` %in% no_response_list))%>%
  mutate(response = "no")%>%
  data.frame()
tot <- no_response_df[,2] + yes_response_df[,2]
tot <- c(tot, tot)

response_df <- rbind(yes_response_df,no_response_df)
response_df <- cbind(response_df, tot)
colnames(df)
##  [1] "CAD Event Number"            "Event Clearance Description"
##  [3] "Call Type"                   "Priority"                   
##  [5] "Initial Call Type"           "Final Call Type"            
##  [7] "Original Time Queued"        "Arrived Time"               
##  [9] "Precinct"                    "Sector"                     
## [11] "Beat"                        "year_queued"                
## [13] "year_arrived"

Seattle Police Precincts

The Seattle Police Department has five Precincts: East, North, South, Southwest, and West. Their locations are represented on the map below at each of the circle markers. The size of the circle marker is representative of the average amount of events each precinct handles per year. If you hover over the markers, you will see the name of the precinct and the annual event count. By clicking on the marker, a comprehensive breakdown of events by priority.

Based on the annual events, the North and the West are the most active of the 5 precincts. Two notable observations on the proportion of events: The North responds to the least amount of priority 7 calls, while the West responds to the most priority 9 calls.

precinct_df <- calls_with_location %>%
  select(Precinct, Priority, `Original Time Queued`)%>%
  mutate(year = year(mdy_hms(`Original Time Queued`)))%>%
  group_by(Precinct, Priority)%>%
  filter(!year %in% c(2009, 2022))%>%
  summarise(n=round(length(Priority)/length(unique(year)),1), .groups = 'keep')%>%
  group_by(Precinct) %>%
  mutate(precent_of_total = round(100*n/sum(n),1))%>%
  ungroup()%>%
  data.frame()

call_e <-t(precinct_df[,3])
percent_e <- t(precinct_df[,4])

EAST      <- c(47.615098498775936, -122.31704882025953, sum(call_e[1:9]), percent_e[1:9])
NORTH     <- c(47.70291922207376, -122.3345396161147, sum(call_e[10:18]), percent_e[10:18])
SOUTH     <- c(47.5386598607152, -122.29339767108803, sum(call_e[19:27]), percent_e[19:27]) 
SOUTHWEST <- c(47.53583797448739, -122.3618548391665, sum(call_e[28:35]), percent_e[28:35])
WEST      <- c(47.61617264433508, -122.33705795897504, sum(call_e[36:43]), percent_e[36:43])

WEST<- append(WEST, 0, after = 10)
SOUTHWEST <- append(SOUTHWEST, 0, after = 10)

gps_df<-data.frame(rbind(EAST, NORTH, SOUTH, SOUTHWEST, WEST))
colnames(gps_df) <- c("lat", "lng", "annual_events","priority1", "priority2", "priority3", "priority4",
                      "priority5", "priority6","priority7","priority8",'priority9')
mylabels<-c("annual_events","priority1", "priority2", "priority3", "priority4",
"priority5", "priority6","priority7","priority8",'priority9')

tot_prec_events <- calls_with_location %>%
  select(Precinct, Priority, `Original Time Queued`)%>%
  mutate(year = year(mdy_hms(`Original Time Queued`)))%>%
  group_by(Precinct)%>%
  filter(!year %in% c(2009, 2022))%>%
  summarise(n=n())%>%
  data.frame()

leaflet()%>%
  addTiles()%>%
  setView(lat = 47.63, lng = -122.3, zoom = 11)%>%
  addCircleMarkers(lat = gps_df$lat,
             lng = gps_df$lng,
             radius = gps_df$annual_events/9000,
             popup = paste(row.names(gps_df),
                           "<br/>Annual Events=",
                           gps_df$annual_events,
                           "<br/>Priority 1 =",
                           gps_df$priority1,
                           "%<br/>Priority 2 =",
                           gps_df$priority2,
                           "%<br/>Priority 3 =",
                           gps_df$priority3,
                           "%<br/>Priority 4 =",
                           gps_df$priority4,
                           "%<br/>Priority 5 =",
                           gps_df$priority5,
                           "%<br/>Priority 6 =",
                           gps_df$priority6,
                           "%<br/>Priority 7 =",
                           gps_df$priority7,
                           "%<br/>Priority 8 =",
                           gps_df$priority8,
                           "%<br/>Priority 9 =",
                           gps_df$priority9,
                           "%",
                           sep = ' '),
             label = paste(row.names(gps_df), "Annual Events = ",gps_df$annual_events, sep = "\n"))

For viewing purposes, the table below contains the comprehensive breakdown of events by priority percentages.

maptable <- gps_df
maptable$lat = NULL
maptable$lng = NULL
maptable <-t(maptable)
maptable
##                  EAST    NORTH   SOUTH SOUTHWEST     WEST
## annual_events 61915.2 101483.7 62599.0   40677.8 113239.5
## priority1        11.5     12.8    12.4      12.5     11.0
## priority2        21.2     25.9    20.7      21.5     22.8
## priority3        32.9     37.8    31.1      32.9     29.2
## priority4         3.2      3.4     2.9       2.7      2.3
## priority5         2.4      3.2     1.9       2.1      2.3
## priority6         0.8      1.0     0.6       0.7      0.8
## priority7        24.3     12.9    27.2      25.2     24.2
## priority8         0.0      0.0     0.0       0.0      0.0
## priority9         3.7      3.0     3.2       2.4      7.4

Priorities and Response Times

The barchart below depicts the total amount of calls for each priority, while the lineplot represents the average response time for each priority level call.

Based on the barchart, the most events fall under priorities 1,2,3, and 7. Priority levels 1-4 pertain primarily to 911 calls in requesting police assistance, 5 and 6 are reserved for unique teams, and 7 priorities designate activity of officers on the scene.

The line trend shows a relation between emergency level of events and the time for officers to arrive. As the level of priority increases from 1-4, the response time increases as well. This is a good sign of police rapid response for top priority emergency calls, while also demonstrating more through investigation of low priority events.

Priority levels 7+ can be seen averaging instant response times, most likely a result of officers being on premise during event. Priority level 8 has recorded nearly zero events, so the response time is negligible when considering the 7+ section of priorities.

pr <- a %>%
  select(Priority, response) %>%
  group_by(Priority) %>%
  summarise(i = mean(response)) %>%
  data.frame()
pr$imin <- pr$i/60

priority_df <- a %>%
  select(Priority) %>%
  group_by(Priority) %>%
  summarise(n=n())  %>%
  data.frame()


barline<- ggplot(pr, aes(x = Priority, y = i/60)) +
  theme_igray() +
  labs(title = "Call Priority Count and Response Time", y = "Response Time (Minutes) - Lineplot", x= "Priority Level")+
  theme(plot.title = element_text(hjust = 0.5, size = 18), 
        axis.text.y.right = element_text(color = "slateblue"), 
        axis.title.y.right = element_text(color = "slateblue", face = "bold"),
        axis.title.y.left = element_text(face = "bold", color = "coral")) +
  scale_x_continuous(n.breaks = 10) +
  geom_bar(inherit.aes = FALSE, 
           data = priority_df, 
           aes(x = Priority, y = n/1e4), 
           stat = "identity",
           fill = "steelblue4",
           color = "grey75",
           width = 1
  ) +
  geom_line(size = 2.5, color = "grey60") +
  geom_point(shape = 21, size = 3, color = "black", fill = "coral") +
  scale_y_continuous(sec.axis = sec_axis(~. *1e4, labels = comma, name = "Count of Calls - Barchart")) 
barline

Call Event Heatmap

The heatmap below shows the top 10 most common calls by priority. The heat (intensity of color) represents the amount of calls in total for “Initial Call Type”. By hovering over each cell, you can view the amount of calls and the priority; while hovering over each word will show the full description of the call label.

An understanding of what type of priority can be given for each call can be from the labels of event categories. For example, if a call is made regarding an assault with or without weapons, the SPD would respond with a priority level 1 intent and thus arrive on the scene rapidly.

Based on the heat, most common 911 calls are levels 2 and 3 for suspicious activity, disturbances, or theft - this would imply that calls in are lower levels of violence with criminal activity. Even more notably, the most heat revolves around level 7 officer initiated premise checks and onview patrol stops. This indicates a large amount of time is dedicated to officers on scene checking premises or responding to perceived illegal activity.

i<--1
collect = NULL
while (i< 10) {
  prior <- data.frame()
  prior <- count(a[a$Priority == i,], `Initial Call Type`)
  prior <-prior[order(n, decreasing = TRUE),]
  prior <-prior[1:10]
  prior$priority <- i
  prior$rank <- seq.int(nrow(prior))
  collect<-rbind(collect, prior)
  i = i+1
}
na_col_collect <- which(is.na(collect$n))
pr_cc_df<- collect[-na_col_collect]
pr_cc_df$priority <- as.factor(pr_cc_df$priority)
pr_cc_df$rank <- as.factor(pr_cc_df$rank)
breaks <- c(seq(0, max(pr_cc_df$n)+40000, by=20000))


heat<- ggplot(data = pr_cc_df, aes(x = priority, y= rank, fill = n))+
  geom_tile(color = "black")+
  labs(title = "Most Frequent Calls by Priority",
       x = 'Priority of Call',
       y = 'Amount of Calls',
       fill = 'Call Count')+
  theme_minimal()+
  theme(plot.title = element_text(hjust = 0.5))+
  scale_y_discrete(limits = rev(levels(pr_cc_df$rank))) +
  scale_fill_continuous(low = "white", high = "slateblue", label = comma, breaks = breaks)+
  guides(fill = guide_legend(reverse = TRUE, override.aes = list(color= "black")))+
  geom_text(aes(label= substr(`Initial Call Type`, 1, 7)))+
  geom_text(aes(label= `Initial Call Type`),
            alpha = 0)

heat_plot<-ggplotly(heat,
                    tooltip = c("Initial Call Type" ,"priority", "n"))%>%
  style(hoverlabel = list(bgcolor = "white"))
heat_plot

Top 10 events of action/no action

After a call has been made, or an officer has initiated a call, the event of action is classified into an “Event Clearance Description”. The chart below represents the top 10 police actions. In total, rendering assistance occurred the most by far, which helps answer the question - is the SPD helpful?

The events with red outlines represent actions that could be considered not helpful or null actions. Being unable to locate a call for help can be an indicator that the SPD is not helpful.

events <- df %>%
  select(`Event Clearance Description`) %>%
  group_by(`Event Clearance Description`) %>%
  summarise(n=n())  %>%
  data.frame()
top_ten <- events[order(events$n, decreasing = TRUE),]
top_ten <- top_ten[0:10,]
no_action <- events$Event.Clearance.Description[c(1,6,9, 12, 13, 26)]


event10 <- ggplot(top_ten, aes(x= reorder(Event.Clearance.Description,n,sum), y = n)) +
  geom_bar(stat = "identity", fill = "slateblue", 
           size = 1.2,color = ifelse(top_ten$Event.Clearance.Description %in% no_action, "red","white")) +
  theme_igray() +
  coord_flip() +
  labs(title = "Response Count by Event Type (Top 10)", x = "Event Description", y= "Event Count") +
  theme(plot.title = element_text(hjust = -0.8, size = 18, face = "bold"), axis.text.y = element_text(size = 8, face = "bold")) +
  scale_y_continuous(labels = comma, limits = c(0,2.35e6))+
  geom_text(data = top_ten, aes(x= Event.Clearance.Description, y = n, label = comma(n)), hjust = -0.1, vjust = 1)
event10

Top 10 events with response times from priorities 1-3

The stacked barchart below further dives into the top 10 events, but now breaking down by priority levels 1,2, and 3 against response times.

With this graph, a few notable insights can be found:

First, emergency events show rapid response as seen by priority 1 response times for all events. Second, the response times generally is slower as the priority level increases from 1 to 2 to 3. Lastly, the events considered null action in the graph above have a significantly longer response time as the priority level increases.

This shows the SPD is rapid in response to emergencies, but spends more time attempting to prevent null actions when time is available. This could mean, for instance, that if a 911 call is made from a homeowner about a disturbance the SPD would take extra time to locate and investigate the situation.

response_priority<-ggplot(cp_df, aes(x = event_order, y = respond_seconds/60, fill = Priority))+
  coord_flip()+
  geom_bar(stat = 'identity',
           position = 'dodge')+
  theme_igray() +
  labs(title = "Response Times for Top 10 Events by Most Commmon Priority Levels",
       x = "Event Description",
       y = "Response Time (minutes)")+
  theme(plot.title = element_text(hjust = 0.8, size = 18, face = "bold"), axis.text.y = element_text(size = 8, face = "bold"))+
  scale_x_discrete(limits=rev)+
  scale_fill_brewer(palette = 'Reds', direction = -1)

response_priority

Police Activity by Priority Level

The breakdown of successful vs. unsuccessful actions can be observed by priority. Not surprisingly, when an event is classified as priority level 7 there is a very high rate of action.

1

no_response_list<- events$Event.Clearance.Description[c(1,2,6,9,12,13,22,26)]
response_list<-events$Event.Clearance.Description[-c(1,2,6,9,12,13,22,26)]

yes_response_df <- a %>%
  select(Priority, `Event Clearance Description`)%>%
  group_by(Priority)%>%
  summarise(n=sum(`Event Clearance Description` %in% response_list))%>%
  mutate(response = "yes")%>%
  data.frame()
no_response_df <- a %>%
  select(Priority, `Event Clearance Description`)%>%
  group_by(Priority)%>%
  summarise(n=sum(`Event Clearance Description` %in% no_response_list))%>%
  mutate(response = "no")%>%
  data.frame()
tot <- no_response_df[,2] + yes_response_df[,2]
tot <- c(tot, tot)

response_df <- rbind(yes_response_df,no_response_df)
response_df <- cbind(response_df, tot)

d0<-plot_ly()%>%
  add_pie(data = response_df[response_df$Priority == 1,], 
          labels = ~response,
          values = ~n,
          hole=0.5)%>%
  layout(title = "Action Taken for Events by Priority: Level 1",
         annotations = list(text=paste0("Total Call Count for Priority Level: \n",
                                        scales::comma(response_df$tot[1])),
                            "showarrow"=F))

d0

2

d2<-plot_ly()%>%
  add_pie(data = response_df[response_df$Priority == 2,], 
          labels = ~response,
          values = ~n,
          hole=0.5)%>%
  layout(title = "Action Taken for Events by Priority: Level 2",
         annotations = list(text=paste0("Total Call Count for Priority Level: \n",
                                        scales::comma(response_df$tot[2])),
                            "showarrow"=F))
d2

3

d3<-plot_ly()%>%
  add_pie(data = response_df[response_df$Priority == 3,], 
          labels = ~response,
          values = ~n,
          hole=0.5)%>%
  layout(title = "Action Taken for Events by Priority: Level 3",
         annotations = list(text=paste0("Total Call Count for Priority Level: \n",
                                        scales::comma(response_df$tot[3])),
                            "showarrow"=F))
d3

4

d4<-plot_ly()%>%
  add_pie(data = response_df[response_df$Priority == 4,], 
          labels = ~response,
          values = ~n,
          hole=0.5)%>%
  layout(title = "Action Taken for Events by Priority: Level 4",
         annotations = list(text=paste0("Total Call Count for Priority Level: \n",
                                        scales::comma(response_df$tot[4])),
                            "showarrow"=F))
d4

5

d5<-plot_ly()%>%
  add_pie(data = response_df[response_df$Priority == 5,], 
          labels = ~response,
          values = ~n,
          hole=0.5)%>%
  layout(title = "Action Taken for Events by Priority: Level 5",
         annotations = list(text=paste0("Total Call Count for Priority Level: \n",
                                        scales::comma(response_df$tot[5])),
                            "showarrow"=F))
d5

6

d6<-plot_ly()%>%
  add_pie(data = response_df[response_df$Priority == 6,], 
          labels = ~response,
          values = ~n,
          hole=0.5)%>%
  layout(title = "Action Taken for Events by Priority: Level 6",
         annotations = list(text=paste0("Total Call Count for Priority Level: \n",
                                        scales::comma(response_df$tot[6])),
                            "showarrow"=F))
d6

7

d7<-plot_ly()%>%
  add_pie(data = response_df[response_df$Priority == 7,], 
          labels = ~response,
          values = ~n,
          hole=0.5)%>%
  layout(title = "Action Taken for Events by Priority: Level 7",
         annotations = list(text=paste0("Total Call Count for Priority Level: \n",
                                        scales::comma(response_df$tot[7])),
                            "showarrow"=F))
d7

8

d8<-plot_ly()%>%
  add_pie(data = response_df[response_df$Priority == 8,], 
          labels = ~response,
          values = ~n,
          hole=0.5)%>%
  layout(title = "Action Taken for Events by Priority: Level 8",
         annotations = list(text=paste0("Total Call Count for Priority Level: \n",
                                        scales::comma(response_df$tot[8])),
                            "showarrow"=F))
d8

9

d9<-plot_ly()%>%
  add_pie(data = response_df[response_df$Priority == 9,], 
          labels = ~response,
          values = ~n,
          hole=0.5)%>%
  layout(title = "Action Taken for Events by Priority: Level 9",
         annotations = list(text=paste0("Total Call Count for Priority Level: \n",
                                        scales::comma(response_df$tot[9])),
                            "showarrow"=F))
d9

Conclusion

The Seattle Police Department has shown to be rapidly responsive in emergency situations, while thorough in lower priority events. They are responsible for responding to numerous events ranging from assault to burglary to noise complaints. Each call dictates an appropriate response, and they have shown to be efficient in their priorities. Most of the SPD time is spent either responding to calls or patrolling for onview actions.

I have found their rate of emergency response to be comforting enough to live there, but their amount of traffic stops to possibly prevent me from driving through. What do you think, is the SPD helpful or are their aspects you would like to see improved?