Predictive policing is a multi-dimensional optimization problem where law enforcement agencies try to efficiently utilize a scarce resource to minimize instances of crime overtime and across geographies. But how do we optimize? This is precisely what we answer in this assignment by using real and publicly available criminal data of Chicago. Using statistics and computer aided technologies we try to devise a solution for this optimization problem. In an attempt to address a real-world problem, our primary focus here is on the fundamentals of data rather than on acrobatics with techniques.
Crime analysis includes looking at the data from 2 different dimension spatial and temporal. Spatial dimension involves observing the characteristics of a particular region along with its neighbor. Temporal dimension involves observing the characteristics of a particular region overtime. The question then is how far away, from the epicenter, do we look for a similar pattern and how far back in time, from the date of event, do we go to capture the trend. Ideally we would like to have as much data as possible. Often, in reality we don’t, and that makes data science a creative process. A process bound by mathematical logic in centered around statistical validity.
Crime data are not easy to deal with period with both spatial and temporal attributes, processing them can be a challenging task. The challenge is not limited to handling spatial and temporal data but also deriving information from them at these levels. Any predictive model for crime will have to have these 2 dimensions attached to it. And to make an effort toward effective predictive policing strategies, this inherent structure of the data needs to be leveraged.
For this exercise, we use crime data for the city of Chicago which are available from 2001 onwards on the city’s open data portal. Crime data for city of Chicago available from their open data portal at: https://data.cityofchicago.org/. To make analysis manageable, we utilized the past one year of data from the current date.
R has the capability of reading files and data tables directly from the Web. We can do this by specifying the connection string instead of the file name in the read_csv() function. We can access the Chicago crime data from the following url: https://data.cityofchicago.org/api/views/x2n5-8w5q/rows.csv?accessType=DOWNLOAD
library(tidyverse)
# Download one year of crime data from the open data portal of city of Chicago
# NOTE: This may take a while depening on the strength of your internet connection
# First I ran read_csv() to find the default col_types() then I updated them to this:
type=cols( `CASE#` = col_character(),
`DATE OF OCCURRENCE` = col_datetime(format="%m/%d/%Y %I:%M:%S %p"),
BLOCK = col_factor(),
IUCR = col_factor(),
`PRIMARY DESCRIPTION` = col_factor(),
`SECONDARY DESCRIPTION` = col_factor(),
`LOCATION DESCRIPTION` = col_factor(),
ARREST = col_factor(),
DOMESTIC = col_factor(),
BEAT = col_factor(),
WARD = col_factor(),
`FBI CD` = col_factor(),
`X COORDINATE` = col_double(),
`Y COORDINATE` = col_double(),
LATITUDE = col_double(),
LONGITUDE = col_double(),
LOCATION = col_character()
)
# Specify download url
url.data <- "https://data.cityofchicago.org/api/views/x2n5-8w5q/rows.csv?accessType=DOWNLOAD"
# Read in data
crime_raw <- read_csv(url.data, na='',col_types = type)
# Fix column names
names(crime_raw)<-str_to_lower(names(crime_raw)) %>%
str_replace_all(" ","_") %>%
str_replace_all("__","_") %>%
str_replace_all("#","_num")
Before we start playing with data, it is important to understand how the data are organized, what fields are present in the table, and how they are stored. We can investigate the internal structure of this data easily since it’s stored as a tibble.
crime_raw
str(crime_raw)
## spec_tbl_df [209,632 x 17] (S3: spec_tbl_df/tbl_df/tbl/data.frame)
## $ case_num : chr [1:209632] "JF156487" "JE362576" "JE364188" "JE364232" ...
## $ date_of_occurrence : POSIXct[1:209632], format: "2021-12-01 00:01:00" "2021-09-05 14:47:00" ...
## $ block : Factor w/ 26890 levels "056XX N SPAULDING AVE",..: 1 2 3 4 5 6 7 8 9 10 ...
## $ iucr : Factor w/ 301 levels "2820","1320",..: 1 2 3 4 5 6 4 7 8 9 ...
## $ primary_description : Factor w/ 31 levels "OTHER OFFENSE",..: 1 2 3 2 4 5 2 6 5 7 ...
## $ secondary_description: Factor w/ 280 levels "TELEPHONE THREAT",..: 1 2 3 4 5 3 4 6 7 8 ...
## $ location_description : Factor w/ 129 levels "APARTMENT","STREET",..: 1 2 3 4 5 3 1 6 2 3 ...
## $ arrest : Factor w/ 2 levels "N","Y": 1 1 2 1 1 1 1 1 1 2 ...
## $ domestic : Factor w/ 2 levels "N","Y": 1 2 1 1 1 1 1 1 1 1 ...
## $ beat : Factor w/ 274 levels "1711","511","1123",..: 1 2 3 4 5 6 7 8 9 10 ...
## $ ward : Factor w/ 51 levels "39","9","28",..: 1 2 3 4 5 6 7 1 8 9 ...
## $ fbi_cd : Factor w/ 26 levels "08A","14","06",..: 1 2 1 2 3 4 2 5 6 7 ...
## $ x_coordinate : num [1:209632] NA 1181052 1154061 1172637 1100317 ...
## $ y_coordinate : num [1:209632] NA 1837198 1900783 1863365 1935229 ...
## $ latitude : num [1:209632] NA 41.7 41.9 41.8 42 ...
## $ longitude : num [1:209632] NA -87.6 -87.7 -87.6 -87.9 ...
## $ location : chr [1:209632] NA "(41.708514886, -87.61258026)" "(41.883578698, -87.709734846)" "(41.780509717, -87.642627358)" ...
## - attr(*, "spec")=
## .. cols(
## .. `CASE#` = col_character(),
## .. `DATE OF OCCURRENCE` = col_datetime(format = "%m/%d/%Y %I:%M:%S %p"),
## .. BLOCK = col_factor(levels = NULL, ordered = FALSE, include_na = FALSE),
## .. IUCR = col_factor(levels = NULL, ordered = FALSE, include_na = FALSE),
## .. `PRIMARY DESCRIPTION` = col_factor(levels = NULL, ordered = FALSE, include_na = FALSE),
## .. `SECONDARY DESCRIPTION` = col_factor(levels = NULL, ordered = FALSE, include_na = FALSE),
## .. `LOCATION DESCRIPTION` = col_factor(levels = NULL, ordered = FALSE, include_na = FALSE),
## .. ARREST = col_factor(levels = NULL, ordered = FALSE, include_na = FALSE),
## .. DOMESTIC = col_factor(levels = NULL, ordered = FALSE, include_na = FALSE),
## .. BEAT = col_factor(levels = NULL, ordered = FALSE, include_na = FALSE),
## .. WARD = col_factor(levels = NULL, ordered = FALSE, include_na = FALSE),
## .. `FBI CD` = col_factor(levels = NULL, ordered = FALSE, include_na = FALSE),
## .. `X COORDINATE` = col_double(),
## .. `Y COORDINATE` = col_double(),
## .. LATITUDE = col_double(),
## .. LONGITUDE = col_double(),
## .. LOCATION = col_character()
## .. )
## - attr(*, "problems")=<externalptr>
summary(crime_raw)
## case_num date_of_occurrence
## Length:209632 Min. :2021-04-13 05:11:00
## Class :character 1st Qu.:2021-07-12 13:10:45
## Mode :character Median :2021-10-05 11:32:30
## Mean :2021-10-09 11:07:59
## 3rd Qu.:2022-01-04 22:00:00
## Max. :2022-04-12 23:54:00
##
## block iucr
## 0000X W TERMINAL ST : 514 0486 : 19365
## 001XX N STATE ST : 433 0820 : 16344
## 003XX E RANDOLPH ST : 317 0810 : 14471
## 100XX W OHARE ST : 238 0560 : 12882
## 0000X N STATE ST : 217 1310 : 12525
## 064XX S DR MARTIN LUTHER KING JR DR: 215 0460 : 12474
## (Other) :207698 (Other):121571
## primary_description secondary_description
## THEFT :43887 SIMPLE : 25611
## BATTERY :41106 DOMESTIC BATTERY SIMPLE: 19365
## CRIMINAL DAMAGE :25212 $500 AND UNDER : 16344
## ASSAULT :20473 OVER $500 : 14471
## OTHER OFFENSE :14102 TO PROPERTY : 12525
## DECEPTIVE PRACTICE:13933 TO VEHICLE : 12252
## (Other) :50919 (Other) :109064
## location_description arrest domestic
## STREET :53277 N:185613 N:165448
## APARTMENT :44070 Y: 24019 Y: 44184
## RESIDENCE :29447
## SIDEWALK :11704
## PARKING LOT / GARAGE (NON RESIDENTIAL): 6950
## SMALL RETAIL STORE : 6139
## (Other) :58045
## beat ward fbi_cd x_coordinate
## 1834 : 2422 42 : 10320 06 :43887 Min. :1091242
## 421 : 1886 27 : 9677 08B :33365 1st Qu.:1153717
## 624 : 1713 28 : 9456 14 :25212 Median :1167181
## 1831 : 1602 6 : 7920 08A :17345 Mean :1165306
## 511 : 1560 24 : 7602 26 :14317 3rd Qu.:1176817
## 123 : 1546 8 : 6990 11 :12674 Max. :1205119
## (Other):198903 (Other):157667 (Other):62832 NA's :3776
## y_coordinate latitude longitude location
## Min. :1813909 Min. :41.65 Min. :-87.94 Length:209632
## 1st Qu.:1858552 1st Qu.:41.77 1st Qu.:-87.71 Class :character
## Median :1891822 Median :41.86 Median :-87.66 Mode :character
## Mean :1886119 Mean :41.84 Mean :-87.67
## 3rd Qu.:1909171 3rd Qu.:41.91 3rd Qu.:-87.63
## Max. :1951499 Max. :42.02 Max. :-87.53
## NA's :3776 NA's :3776 NA's :3776
crime_raw %>%
group_by(case_num) %>%
mutate(count=n()) %>%
filter(count>1)
The data are stored at a crime incident global, that is, there is observation for each crime incident and the data table. Each incident has a unique identifier associated with it which is stored in the case_number variable. By definition then, case_number should have all unique values however we see that some instances are duplicated, i.e., there are two or more rows which have the same case value. For example, there are two rows in the data that have a case value equal to “JF152198”.
# Get row names for display
getrow<-t(filter(crime_raw,case_num=='JF152198'))
# Create tibble for example duplicate record
JF152198<-as_tibble(t(filter(crime_raw,case_num=='JF152198')),.name_repair=NULL,validate=NULL)
# add row names and reorganize the duplicate for display
JF152198 %>%
mutate(Variable=rownames(getrow)) %>%
rename(Row1=V1,Row2=V2) %>%
select(Variable, Row1, Row2)
These duplicated rows need to be removed. Since the differences only exist in one variable and the difference is minor, these duplications are likely a recording error. We can exlude the duplicated case_number’s with the distinct command inside the of the dplyr::filter command function
# Remove duplicates
crime_no_dup<-filter(distinct(crime_raw,case_num,.keep_all=TRUE))
# Check to make sure
crime_no_dup %>%
group_by(case_num) %>%
summarize(count=n()) %>%
filter(count>1)
The date_of_occurrence gives an approximate date and time stamp as to when the crime incident might have happened. This variable was initially read in as a character, but I used the col_datetime() designation with the correct format to make R recognize that this is in fact a date.
crime_no_dup %>%
select(date_of_occurrence) %>%
head()
crime_no_dup %>%
select(date_of_occurrence) %>%
tail()
The timezone for date_of_occurrence should be America/Chicago, even though the timezone is stored in R as Coordinated Universal Time (UTC). Time zone is actually unnecessary since all of the crimes committed occured in the same time zone. As such, I’m going to leave the timezone as UTC for this analysis. Moreover, setting the time zone to America/Chicago coerces four date_of_occurrence to NA since March 1, 2020 02:00:00 doesn’t exist (thank you daylight savings). As there were definitely crimes committed those records should remain in the data set.
R understands the data stored in the date_of_occurrence column is a date and time stamp. Processing the data a bit further we can separate the time stamps from the date part using the functions from the lubridate library.
The frequency of crimes is probably not consistent throughout the day. There could be certain time intervals of the day where criminal activity is more prevalent compared to other intervals. To check this, we can bucket the timestamps into a few categories and then see the distribution the buckets. As an example we create four 6-hour time windows beginning at midnight to bucket the time stamps. The four time intervals we get are midnight to 6 AM, 6 AM to noon, noon to 6 PM, and 6 PM to midnight.
For bucketing we first create variable bins using the four time intervals mentioned above. Once the bins are created the next step is to match each timestamp in the data to one of these time enter this can be done using the cut function.
# Remove timestamp from datetime and place in separate column
library(lubridate)
crime_clean<-crime_no_dup %>%
mutate(time=hms::as.hms(hour(date_of_occurrence)*60+minute(date_of_occurrence)), # Remove timestamp from datetime and place in separate column
date=date(date_of_occurrence), # Separate date part from date time
time_group=cut(as.numeric(time),breaks=c(0,6*60,12*60,18*60,23*60+59),labels=c("00-06","06-12","12-18","18-00"),include.lowest = TRUE))
crime_clean %>% select(case_num, date_of_occurrence, date, time, time_group)
crime_clean %>% group_by(time_group) %>% summarize(count=n())
The distribution of crime incidents across the day suggests that crimes are more frequent during the latter half of the day.
One of the core aspects of data mining is deriving increasigly more information from the limited data that we have. We will see a few examples of what we mean by this as we go along. Let’s start with something simple and intuitive.
We can use the date of incidence to determine which day of the week and which month of the year the crime occurred. It is possible that there is a pattern in the way crimes occur (or are committed) depending on the day of the week and month.
crime_clean <- crime_clean %>%
mutate(
day=wday(date,label=TRUE,abbr=TRUE),
month=month(date,label=TRUE,abbr=TRUE)
)
crime_clean %>% select(case_num, date_of_occurrence, day, month)
There are two fields in the data which provide the description of the crime incident. The first, primary description provides a broad category of the crime type and the second provides more detailed information about the first. We use the primary description to categorize different crime types.
# Specific crime types
(t<-crime_clean %>%
group_by(primary_description) %>%
summarize(count=n()) %>%
arrange(desc(count)))
The data contains 31 crime types; not all of which are mutually exclusive. We can combine two or more similar categories into one to reduce this number and make the analysis a bit more manageable.
# Some categories can be combined to reduce this number
crime_clean<-crime_clean %>%
mutate(
crime=fct_recode(primary_description,
"DAMAGE"="CRIMINAL DAMAGE",
"DRUG"="NARCOTICS",
"DRUG"="OTHER NARCOTIC VIOLATION",
"FRAUD"="DECEPTIVE PRACTICE",
"MVT"="MOTOR VEHICLE THEFT",
"NONVIOLENT"="LIQUOR LAW VIOLATION",
"NONVIOLENT"="CONCEALED CARRY LICENSE VIOLATION",
"NONVIOLENT"="STALKING",
"NONVIOLENT"="INTIMIDATION",
"NONVIOLENT"="GAMBLING",
"NONVIOLENT"="OBSCENITY",
"NONVIOLENT"="PUBLIC INDECENCY",
"NONVIOLENT"="INTERFERENCE WITH PUBLIC OFFICER",
"NONVIOLENT"="PUBLIC PEACE VIOLATION",
"NONVIOLENT"="NON-CRIMINAL",
"OTHER"="OTHER OFFENSE",
"SEX"="HUMAN TRAFFICKING",
"SEX"="CRIMINAL SEXUAL ASSAULT",
"SEX"="SEX OFFENSE",
"SEX"="CRIM SEXUAL ASSAULT",
"SEX"="PROSTITUTION",
"TRESSPASS"="CRIMINAL TRESPASS",
"VIOLENT"="KIDNAPPING",
"VIOLENT"="WEAPONS VIOLATION",
"VIOLENT"="OFFENSE INVOLVING CHILDREN"
),
crime_type=fct_recode(crime,
"VIOLENT"="SEX",
"VIOLENT"="ARSON",
"VIOLENT"="ASSAULT",
"VIOLENT"="HOMICIDE",
"VIOLENT"="VIOLENT",
"VIOLENT"="BATTERY",
"NONVIOLENT"="BURGLARY",
"NONVIOLENT"="DAMAGE",
"NONVIOLENT"="DRUG",
"NONVIOLENT"="FRAUD",
"NONVIOLENT"="MVT",
"NONVIOLENT"="NONVIOLENT",
"NONVIOLENT"="ROBBERY",
"NONVIOLENT"="THEFT",
"NONVIOLENT"="TRESSPASS",
"NONVIOLENT"="OTHER"
) # Further combination into violent and non-violent crime types
)
crime_clean %>%
group_by(crime) %>%
summarize(count=n()) %>%
arrange(desc(count))
crime_clean %>%
group_by(crime_type) %>%
summarize(count=n()) %>%
arrange(count)
With a couple of basic variables in place, we can start with a few visualizations to see how, when, and where are the crime incidents occuring.
Visualizing data is a powerful way to derive high-level insights about the underlying patterns in the data. Visualizations provide helpful clues as to where we need to investigate further. To see a few examples, we start with some simple plots of variables we processed in the previous section using the powerful ggplot2 library.
# Frequency of crime
library(scales)
crime_clean %>%
group_by(crime) %>%
summarise(count=n()) %>%
ggplot(aes(x = reorder(crime,count), y = count)) +
geom_bar(stat = "identity", fill = "#756bb1") +
labs(x ="Crimes", y = "Number of crimes", title = "Crimes in Chicago") +
scale_y_continuous(label = comma) +
coord_flip()
Prevalence of different crimes seem to be an evenly distributed in Chicago with theft and battery being much more frequent. It would be interesting to look at how crimes are distributed with respect to time of day, day of week, and month.
# Time of day
crime_clean %>%
ggplot(aes(x = time_group)) +
geom_bar(fill = "#756bb1") +
labs(x = "Time of day", y= "Number of crimes", title = "Crimes by time of day")
# Day of week
crime_clean %>%
ggplot(aes(x = day)) +
geom_bar(fill = "#756bb1") +
labs(x = "Day of week", y = "Number of crimes", title = "Crimes by day of week")
# Month
crime_clean %>%
ggplot(aes(x = month)) +
geom_bar(fill = "#756bb1") +
labs(x = "Month", y = "Number of crimes", title = "Crimes by month")
There does seem to be a pattern in the occurrence of crime with respect to the dimension of time. The latter part of the day, Fridays, and summer months witness more crime incidents, on average, with respect to other corresponding time periods.
These plots show the combined distribution of all crime with respect to different intervals of time. We can demonstrate the same plots with additional information by splitting out the different crime types. For example, we can see how different crimes vary by different times of the day. To get the number of different crimes by time of day, we need to aggregate the data at a crime – time group level. That is, four rows for each crime type – one for each time interval of the day. An easy way to aggregate data is to use the summarize function.
library(viridis)
library(scales)
crime_clean %>%
group_by(crime,time_group) %>%
summarise(count=n()) %>%
ggplot(aes(x=crime, y=time_group)) +
geom_tile(aes(fill=count)) +
labs(x="Crime", y = "Time of day", title="Theft occurs most often between noon and 6pm") +
scale_fill_viridis_c("Number of Crimes",label=comma) +
coord_flip()
A quick look at the heat map shows that most of the theft incidents occur in the afternoon whereas drug related crimes are more prevalent in the evening.
We can perform a similar analysis by day of week and month as well.
# Crimes by day of the week
crime_clean %>%
group_by(crime,day) %>%
summarise(count=n()) %>%
ggplot(aes(x=crime, y=day)) +
geom_tile(aes(fill=count)) +
labs(x="Crime", y = "Day of week", title="Battery is more prevelant on Sundays") +
scale_fill_viridis_c("Number of Crimes",label=comma) +
coord_flip()
# Crimes by month
# A third way of aggregating data is using the summaryBy function from the doBy package
crime_clean %>%
group_by(crime,month) %>%
summarise(count=n()) %>%
ggplot(aes(x=crime, y=month)) +
geom_tile(aes(fill=count)) +
labs(x="Crime", y = "Month of year", title="Summer is popular for crimes") +
scale_fill_viridis_c("Number of Crimes",label=comma) +
coord_flip()
Till now we have only looked at the temporal distribution of crimes. But there is also a spatial element attached to them. Crimes vary considerably with respect to geographies. Typically, within an area like a zip code, city, or county, there will be pockets or zones which observe higher criminal activity as compared to the others. These zones are labeled as crime hot-stops and are often the focus areas for effective predictive policing. We have the location of each crime incident in our data that can be used to look for these spatial patterns in the city of Chicago. For this purpose, we will utilize the shape files for Chicago Police Department’s beats by processing them in R using the
maptools library. The shape files for CPD beats can be downloaded from https://data.cityofchicago.org/Public-Safety/BoundariesPolice-Beats/kd6k-pxkv.
# Police beat shape files
library(maptools)
beat_shp<-readShapePoly('~/Data Management in R/Assignment 4/PoliceBeats/PoliceBeat.shp')
plot(beat_shp)