For this project, I downloaded the crime data for the city of Boston. There is a ton of opportunity for analysis in this dataset, but here I will just be looking at location data. I wanted to see what the crime in the city looks like at a high level.
First, let’s load our libraries. I used leaflet as my main mapping tool for this project.
library(leaflet)
library(dplyr)
library(RColorBrewer)
library(KernSmooth)
library(knitr)Now, let’s load and prep the data.
mydata = read.csv('Crime_Incident_Reports.csv')
mydata = select(mydata, Crime = INCIDENT_TYPE_DESCRIPTION, Shooting, Year, Lat, Long)
kable(head(mydata))| Crime | Shooting | Year | Lat | Long |
|---|---|---|---|---|
| RESIDENTIAL BURGLARY | No | 2012 | 42.34638 | -71.10379 |
| AGGRAVATED ASSAULT | Yes | 2012 | 42.31684 | -71.07458 |
| ROBBERY | No | 2012 | 42.34284 | -71.09699 |
| COMMERCIAL BURGLARY | No | 2012 | 42.31644 | -71.06583 |
| ROBBERY | No | 2012 | 42.27052 | -71.11990 |
| ROBBERY | Yes | 2012 | 42.31328 | -71.05300 |
Great. We won’t worry too much about messing with the data. Let’s just get started mapping!
First let’s look at where shootings occur.
shootings = filter(mydata, Shooting == 'Yes', !is.na(Lat), !is.na(Long))
shootingLoc = select(shootings, Long, Lat)
shootingHeat = bkde2D(shootingLoc, bandwidth = c(bw.nrd(shootingLoc[,1]), bw.nrd(shootingLoc[,2])))
x= shootingHeat$x1
y = shootingHeat$x2
z = shootingHeat$fhat
contour = contourLines(x,y,z)
shootings2012 = filter(shootings, Year == 2012, !is.na(Lat), !is.na(Long))
shootings2013 = filter(shootings, Year == 2013, !is.na(Lat), !is.na(Long))
shootings2014 = filter(shootings, Year == 2014, !is.na(Lat), !is.na(Long))
shootings2015 = filter(shootings, Year == 2015, !is.na(Lat), !is.na(Long))
shootingsPallette = brewer.pal(4, 'Dark2')
shootingsMap = leaflet(shootings2012) %>%
setView(lng=-71.0689, lat=42.32, 12) %>%
addProviderTiles('Esri.WorldGrayCanvas', group = 'Light Gray') %>%
addProviderTiles('Stamen.Toner', group = 'Black') %>%
addCircles(data = shootings2012, ~Long, ~Lat, weight = 12, radius=12,
color=shootingsPallette[1], stroke = TRUE, opacity = 0.3, fillOpacity = 0.3, group = '2012') %>%
addCircles(data = shootings2013, ~Long, ~Lat, weight = 12, radius=12,
color=shootingsPallette[2], stroke = TRUE, opacity = 0.3, fillOpacity = 0.3, group = '2013') %>%
addCircles(data = shootings2014, ~Long, ~Lat, weight = 12, radius=12,
color=shootingsPallette[3], stroke = TRUE, opacity = 0.3, fillOpacity = 0.3, group = '2014') %>%
addCircles(data = shootings2015, ~Long, ~Lat, weight = 12, radius=12,
color=shootingsPallette[4], stroke = TRUE, opacity = 0.3, fillOpacity = 0.3, group = '2015') %>%
addPolygons(contour[[1]]$x, contour[[1]]$y, fillColor = 'purple', stroke = F, group = 'Heat', fillOpacity = .2) %>%
addPolygons(contour[[2]]$x, contour[[2]]$y, fillColor = 'purple', stroke = F, group = 'Heat', fillOpacity = .2) %>%
addPolygons(contour[[3]]$x, contour[[3]]$y, fillColor = 'purple', stroke = F, group = 'Heat', fillOpacity = .2) %>%
addPolygons(contour[[4]]$x, contour[[4]]$y, fillColor = 'purple', stroke = F, group = 'Heat', fillOpacity = .2) %>%
addPolygons(contour[[5]]$x, contour[[5]]$y, fillColor = 'purple', stroke = F, group = 'Heat', fillOpacity = .2) %>%
addPolygons(contour[[6]]$x, contour[[6]]$y, fillColor = 'purple', stroke = F, group = 'Heat', fillOpacity = .2) %>%
addLayersControl(baseGroups = c('Light Gray', 'Black'),
overlayGroups = c('2012', '2013', '2014', '2015', 'Heat'),
options = layersControlOptions(collapsed = FALSE))
shootingsMapI think it’s interesting how concentrated shootings are in the city. Perhaps you’d expect more shootings to occur in ‘high crime’ areas, but we’ll see later that the section of Boston where most of the shootings happen is actually not the area with the highest crime density.
Moving on, let’s take a look at murders and prostitution charges.
prostitution = filter(mydata, Crime == "PROSTITUTION CHARGES", !is.na(Lat), !is.na(Long))
murder = filter(mydata, Crime == "HOMICIDE", !is.na(Lat), !is.na(Long))
murderIcon = makeIcon('icons/gun2.png', 30,30)
prostitutionIcon = makeIcon('icons/prostitution2.png', 25,30)
murderProstMap = leaflet() %>%
setView(lng=-71.0689, lat=42.32, 12) %>%
addProviderTiles('Esri.WorldGrayCanvas', group = 'Light Gray') %>%
addProviderTiles('Stamen.Toner', group = 'Black') %>%
addMarkers(data = prostitution, lng = ~Long, lat = ~Lat, icon = prostitutionIcon, group = 'Prostitution') %>%
addMarkers(data = murder, lng = ~Long, lat = ~Lat, icon = murderIcon, group = 'Murder') %>%
addLayersControl(baseGroups = c('Light Gray', 'Black'),
overlayGroups = c('Prostitution', 'Murder'),
options = layersControlOptions(collapsed = FALSE))
murderProstMapWhat strikes me most about this map is where all the prostitution charges are happening. Almost all of them are on Blue Hill Ave, and Dorcester Ave. What might explain such a dramaitic distribution? It could be that those streets are ‘the place’ if you’re interested in that sort of thing. I’m a little skeptical that in 2015, prostitutes are just hanging around Dorcester Ave though. We have the internet. Perhaps this deserves some further analysis at a later time. It’s worth noting that this data only contains information that the police know. In this sense, it does not contain records on every crime committed, it only contains records for crimes that the police know about.
The map of murders seems to make a nice subset of the shootings map, which makes sense. Perhaps not every murder was a shooting, but it seems to make sense that the areas of shootings and murders would overlap.
Based on the previous two maps, it would seem like southern Boston has the most crime. However, we’ve only looked at low volume crimes. A murder doesn’t happen every day. But I bet something like aggrivated assault or DUI does. Let’s see which crimes happen the most often in Boston.
count = as.data.frame(table(mydata$Crime))
count = count = count[order(-count$Freq),]
kable(head(count,10))| Var1 | Freq | |
|---|---|---|
| 120 | VAL | 27363 |
| 82 | OTHER LARCENY | 24443 |
| 114 | SIMPLE ASSAULT | 17697 |
| 70 | MedAssist | 17128 |
| 75 | MVAcc | 13832 |
| 122 | VANDALISM | 13339 |
| 56 | InvPer | 12937 |
| 64 | LARCENY FROM MOTOR VEHICLE | 12742 |
| 30 | DRUG CHARGES | 12042 |
| 43 | FRAUD | 8742 |
As we can see, petty crimes are committed far more often than more serious crimes, such as those that involve a shooting.
With this new crime-agnostic view, let’s look at our new crime map.
totalCrime = filter(mydata, !is.na(Lat), !is.na(Long))
locations = select(totalCrime, Long, Lat)
sampleLocations = locations[sample(nrow(locations), 5000),]
heatMapPrep = bkde2D(locations, bandwidth = c(bw.nrd(locations[,1]), bw.nrd(locations[,2])))
x=heatMapPrep$x1
y = heatMapPrep$x2
z = heatMapPrep$fhat
contour = contourLines(x,y,z)
heatPallete = brewer.pal(11, 'Spectral')
crimeHeatMap = leaflet(totalCrime) %>%
setView(lng=-71.0689, lat=42.32, 12) %>%
addProviderTiles('Stamen.Toner') %>%
addCircles(data = sampleLocations, ~Long, ~Lat, weight = 12, radius = 12, opacity = 0.3, fillOpacity = 0.3, color = 'grey') %>%
addPolygons(contour[[1]]$x, contour[[1]]$y, fillColor = heatPallete[10], stroke = F, fillOpacity = .35) %>%
addPolygons(contour[[2]]$x, contour[[2]]$y, fillColor = heatPallete[10], stroke = F, fillOpacity = .35) %>%
addPolygons(contour[[3]]$x, contour[[3]]$y, fillColor = heatPallete[10], stroke = F, fillOpacity = .35) %>%
addPolygons(contour[[4]]$x, contour[[4]]$y, fillColor = heatPallete[9], stroke = F, fillOpacity = .35) %>%
addPolygons(contour[[5]]$x, contour[[5]]$y, fillColor = heatPallete[9], stroke = F, fillOpacity = .35) %>%
addPolygons(contour[[6]]$x, contour[[6]]$y, fillColor = heatPallete[9], stroke = F, fillOpacity = .35) %>%
addPolygons(contour[[7]]$x, contour[[7]]$y, fillColor = heatPallete[8], stroke = F, fillOpacity = .35) %>%
addPolygons(contour[[8]]$x, contour[[8]]$y, fillColor = heatPallete[8], stroke = F, fillOpacity = .35) %>%
addPolygons(contour[[9]]$x, contour[[9]]$y, fillColor = heatPallete[8], stroke = F, fillOpacity = .35) %>%
addPolygons(contour[[10]]$x, contour[[10]]$y, fillColor = heatPallete[7], stroke = F, fillOpacity = .35) %>%
addPolygons(contour[[11]]$x, contour[[11]]$y, fillColor = heatPallete[7], stroke = F, fillOpacity = .35) %>%
addPolygons(contour[[12]]$x, contour[[12]]$y, fillColor = heatPallete[7], stroke = F, fillOpacity = .35) %>%
addPolygons(contour[[13]]$x, contour[[13]]$y, fillColor = heatPallete[7], stroke = F, fillOpacity = .35) %>%
addPolygons(contour[[14]]$x, contour[[14]]$y, fillColor = heatPallete[6], stroke = F, fillOpacity = .35) %>%
addPolygons(contour[[15]]$x, contour[[15]]$y, fillColor = heatPallete[6], stroke = F, fillOpacity = .35) %>%
addPolygons(contour[[16]]$x, contour[[16]]$y, fillColor = heatPallete[6], stroke = F, fillOpacity = .35) %>%
addPolygons(contour[[17]]$x, contour[[17]]$y, fillColor = heatPallete[6], stroke = F, fillOpacity = .35) %>%
addPolygons(contour[[18]]$x, contour[[18]]$y, fillColor = heatPallete[5], stroke = F, fillOpacity = .35) %>%
addPolygons(contour[[19]]$x, contour[[19]]$y, fillColor = heatPallete[5], stroke = F, fillOpacity = .35) %>%
addPolygons(contour[[20]]$x, contour[[20]]$y, fillColor = heatPallete[5], stroke = F, fillOpacity = .35) %>%
addPolygons(contour[[21]]$x, contour[[21]]$y, fillColor = heatPallete[5], stroke = F, fillOpacity = .35) %>%
addPolygons(contour[[22]]$x, contour[[22]]$y, fillColor = heatPallete[4], stroke = F, fillOpacity = .35) %>%
addPolygons(contour[[23]]$x, contour[[23]]$y, fillColor = heatPallete[4], stroke = F, fillOpacity = .35) %>%
addPolygons(contour[[24]]$x, contour[[24]]$y, fillColor = heatPallete[4], stroke = F, fillOpacity = .35) %>%
addPolygons(contour[[25]]$x, contour[[25]]$y, fillColor = heatPallete[4], stroke = F, fillOpacity = .35) %>%
addPolygons(contour[[26]]$x, contour[[26]]$y, fillColor = heatPallete[3], stroke = F, fillOpacity = .35) %>%
addPolygons(contour[[27]]$x, contour[[27]]$y, fillColor = heatPallete[3], stroke = F, fillOpacity = .35) %>%
addPolygons(contour[[28]]$x, contour[[28]]$y, fillColor = heatPallete[3], stroke = F, fillOpacity = .35) %>%
addPolygons(contour[[29]]$x, contour[[29]]$y, fillColor = heatPallete[3], stroke = F, fillOpacity = .35) %>%
addPolygons(contour[[30]]$x, contour[[30]]$y, fillColor = heatPallete[2], stroke = F, fillOpacity = .35) %>%
addPolygons(contour[[31]]$x, contour[[31]]$y, fillColor = heatPallete[2], stroke = F, fillOpacity = .35) %>%
addPolygons(contour[[32]]$x, contour[[32]]$y, fillColor = heatPallete[2], stroke = F, fillOpacity = .3) %>%
addPolygons(contour[[33]]$x, contour[[33]]$y, fillColor = heatPallete[2], stroke = F, fillOpacity = .3) %>%
addPolygons(contour[[34]]$x, contour[[34]]$y, fillColor = heatPallete[1], stroke = F, fillOpacity = .3)
crimeHeatMapNote that the grey marks representing crimes are a sample of all crime, so that the graphic remains responsive. We can now see that downtown has the highest crime density, and there is a bit of a second peak in the southern boston area that we identified earlier.