Section 8.3 Visualising crime distribution along networks
To demonstrate some simpler approaches to visualising crime distribution along networks, we can zoom in a little bit on Heswall town centre. The coordinates for that are: 53.3281041, -3.1025683. Let’s build a buffer.
# create a df of one central point
heswall_tc <- data.frame(longitude = -3.1025683,
latitude = 53.3281041)
# create a buffer by making point into sf object
heswall_tc_buffer <- st_as_sf(heswall_tc,
coords = c("longitude", "latitude"),
crs = 4326) %>%
st_transform(., 27700) %>% # project to BNG (for metres)
st_buffer(., 1000) # build 1km buffer
# select roads that go through town centre
heswall_tc <- st_intersects(heswall_tc_buffer, heswall_lines)
heswall_tc <- heswall_lines[unlist(heswall_tc),]
# select shoplifting incidents in town centre
tc_shoplifting <- st_intersects(heswall_tc_buffer, heswall_shoplifting)
tc_shoplifting <- heswall_shoplifting[unlist(tc_shoplifting),]
ggplot() +
geom_sf(data = heswall_tc) +
geom_sf(data = tc_shoplifting, col = "red") +
geom_sf(data = heswall_tc_buffer, col = "blue", fill = NA) +
theme_void()
Subsection 8.3.1 Hot Routes
In order to map hot spots along a network, we can use a technique called hot routes. Hot routes were devised to be a straightforward spatial technique that analyses crime patterns that are associated with a linear network (e.g., streets and other transportation networks). It allows an analyst to map crime concentrations along different segments of the network and visualise this through colour. We can create a hot routes visualisation by thematically shading each street segment with a colour (and line thickness if desired) that corresponds to the range of the rate of crime per metre. It was used by [Newton (2008)] to map crime and disorder on the bus network in Merseyside. A useful how-to guide on using hot routes was later produced by [Tompson et al. (2009)]. In it they break down the process into four stages:
-
Step 1. Preparing the network layer
-
Step 2. Linking crime events to street segments
-
Step 3. Calculating a rate
-
Step 4. Visualising the results
We can follow those steps here.
Subsubsection 8.3.1.1 Preparing the network layer
The prerequisite to visualising hot routes is to have a network layer which meets certain conditions. For example, [Tompson et al. (2009)] advise that since network layers typically contain streets of unequal length, longer segments might show up as hot simply because they have more space to contain more crimes. Therefore in such cases, it is advisable in this analysis to use equal length street segments, where possible. To address this, they segment their study area into 1 metre length segments using a grid overlay. Another approach is to calculate a rate per metre, instead of count, so that’s the approach we will take here.
Another requirement is that the network layer has a unique identifier for each segment. One quick way to do this, if your data don’t already contain such a column is to create a column that just numbers each row from 1 to the number of observations (rows) in the data frame. Even if you have such a unique identifier, having the row name to a numeric column is required for joining the crimes to the street segments in the next step.
# create numeric unique id column
heswall_tc$unique_id <- 1:nrow(heswall_tc)
Subsubsection 8.3.1.2 Link crime events to street segments
One approach to solve this is to snap each shoplifting incident to the nearest street segment. We can use the
st_nearest_feature() function that will create a list of the ID number of the nearest street segment for each crime incident in our tc_shoplifting object.
nearest_segments <- st_nearest_feature(tc_shoplifting, heswall_tc)
This new object is simply a list of the ID numbers of matched line segments for each of the ASB incidents. For example, here is the ID number of the nearest street segment for the first five ASB incidents in our data:
nearest_segments[1:5]
## [1] 315 315 65 317 317
We can use this to create a frequency table which counts the number of ASB incidents linked to each street segment (by virtue of being nearest to it).
#make list of nearest into df of frequency
nearest_freq <- as.data.frame(table(nearest_segments))
#make sure id is numeric
nearest_freq$nearest_segments <- as.numeric(
as.character(
nearest_freq$nearest_segments
)
)
nearest_freq[1:3,]
## nearest_segments Freq ## 1 1 1 ## 2 17 3 ## 3 27 3
We can see here some examples of the number of shoplifting incidents snapped to each segment. Now we can join this to our spatial layer:
#join to sections object and replace NAs with 0s
heswall_tc <- left_join(heswall_tc,
nearest_freq,
by = c("unique_id" = "nearest_segments")) %>%
mutate(Freq = replace_na(Freq, 0))
We can produce a quick visualisation to check that everything linked OK before moving on to compute a rate normalising for length of street segment.
ggplot() +
geom_sf(data = heswall_tc,
aes(colour = Freq), lwd = 0.5) +
theme_void() +
scale_colour_gradient2(name = "Number of shoplifting incidents",
midpoint = 1,
low = "#2166ac",
mid = "#d1e5f0",
high = "#b2182b")
Looks like we joined the shoplifting incidents to our network layer successfully. Now let’s normalise for the varying length of the street segments.
Subsubsection 8.3.1.3 Calculating a rate
In order to calculate a rate we need the numerator, number of shoplifting incidents, which we joined above, and a denominator to divide by. To control for varying length of the street segments, we might want to consider this length as a suitable denominator. So we need to calculate this for each segment. To achieve this, we can use the
st_length() function.
heswall_tc$length <- st_length(heswall_tc)
Now we have a column in the data which shows the length of each segment in metres (as we are working with projected coordinates). We can see this if we print out one of the values:
heswall_tc$length[1]
## 729.8 [m]
To use it in our calculation, we need this to be a numeric variable, so let’s transform it, and then use it as our denominator to calculate our rate of crimes per metre of street segment length:
heswall_tc$length <- as.numeric(heswall_tc$length)
heswall_tc$shoplifting_rate <- heswall_tc$Freq / heswall_tc$length
Now we have a measure of incidents per metre. Finally, we can move to visualise the results.
Subsubsection 8.3.1.4 Visualise the results
This is very similar to how we carried out a visual check earlier, but this time using our rate as the value to present.
ggplot() +
geom_sf(data = heswall_tc, aes(colour = shoplifting_rate),
lwd = 0.5, alpha = 0.8) +
theme_void() +
scale_colour_gradient2(name = "Shoplifting incidents per metre",
midpoint = mean(heswall_tc$shoplifting_rate),
low = "#2166ac", mid = "#d1e5f0",
high = "#b2182b")
We can now see that the longer road there (Telegraph Road) is no longer so dominant once we’ve controlled for length.
Now this might also be as if it’s a long road it will have a bigger denominator, and as we’re dealing with few crimes here, it might be that artifically dilutes the crime rate. If you suspect this might be the case, then the segmentation might be a better approach, and then refer back to the paper by [Tompson et al. (2009)] for guidance on that.
In any case, we have now created a hot routes visualisation, that helps us map where crime rates are higher along a network. We can add some variations to this if we like; for example we could adjust the width of the segments as well as the colour, although this doesn’t always look the best as it distorts the street network:
ggplot() +
geom_sf(data = heswall_tc,
aes(colour = shoplifting_rate, size = shoplifting_rate),
alpha = 0.8) +
theme_void() +
scale_colour_gradient2(name = "Shoplifting incidents per metre",
midpoint = mean(heswall_tc$shoplifting_rate),
low = "#2166ac", mid = "#d1e5f0",
high = "#b2182b") +
scale_size_continuous(name = "Rate of crimes per metre (width)")
Subsection 8.3.2 Street Profile Analysis
Visualising crime along networks presents an important first step in identifying crime concentration. It may not always be necessary to include the geographic component of a spatial network for the purposes of crime analysis in these networks. Instead, another approach could be to make use of street profile analysis introduced by [Spicer et al. (2016)]. Street profile analysis was initially developed as a method for visualising temporal and spatial crime patterns along major roadways in metropolitan areas. The idea is that the geographical location of the street may not actually be as important as the ability to visualise data from multiple years in a comparable way. So the approach is to treat the street in question as the x-axis of a graph, with a start point (A) and end point (B) breaking it into some interval. Then, you can visualise how crime is distributed along this street by plotting count or rate of crimes on the y-axis, and have multiple lines for different years for example. You can add context by re-introducing some key intersections, or other points of interest. In their paper, Spicer and colleagues demonstrate this using the example of Kingsway Avenue in Vancouver, BC. In this section we will go through how we can apply street profile analysis in R. We will follow the same four steps we did for the hot routes tutorial:
-
Step 1: Prepare the network layer
-
Step 2: Link crime events to points of interest
-
Step 3: Calculate a rate
-
Step 4: Visualise the results
Subsubsection 8.3.2.1 Prepare the network layer
The strength of this approach is to focus on one area of interest. Here let’s choose Telegraph Road. It is a long street which runs through the town centre. To subset it, we can use the names provided by the volunteers of Open Street Map, available in the
name column:
telegraph_rd <- heswall_tc %>% filter(name == "Telegraph Road")
The geometry we have is already separated into seven segments. This is just how we downloaded from OSM. We see there are seven segments, but they don’t necessarily correspond to anything specific. In Street Profile Analysis we want to be conscious about how we divide up the segment. In their paper, [Spicer et al. (2016)] just segment into 100-metre lengths. Another thing we might be interested in is to slice into segments wherever there is an intersection with another road. Here let’s use the intersections as a way to divide our street into segments.
To do this, we create an object of the intersecting streets; let’s call this object
tr_intersects.
# and select also the cross streets into separate object
tr_intersects <- st_intersects(telegraph_rd, heswall_tc)
# subsetting
tr_intersects <- heswall_tc[unlist(tr_intersects),]
# remove Telegraph Road itself
tr_intersects <- tr_intersects %>% filter(name != "Telegraph Road")
We can plot our segments to see whether they correspond to these intersections:
ggplot() +
geom_sf(data = tr_intersects, lwd = 0.5) +
geom_sf(data = telegraph_rd, aes(colour = osm_id), lwd = 1.5, alpha = 0.8) +
theme_void() + theme(legend.position = "none")
We can see that they do not correspond to all the intersections. Unfortunately, we will have to carry out some data cleaning. To do this, first we unite the entire street into one, and then use the intersections to divide into the appropriate segments.
# unite the segments into one long street
telegraph_rd_u <- telegraph_rd %>%
group_by(name) %>%
st_union() %>%
st_cast("LINESTRING")
# use st_split and st_combine to split into parts by intersecting roads
library(lwgeom)
parts <- st_split(telegraph_rd_u, st_combine(tr_intersects$geometry)) %>%
st_collection_extract("LINESTRING")
# combine the parts into one shapefile
datalist = list()
for (i in 1:length(parts)) {
datalist[[i]] <- st_as_sf(data.frame(section = i),
geometry = st_geometry(parts[i]))
}
tr_sections <- do.call(rbind, datalist)
In the above code we do a lot, but it means we end up with a geometry where the segments were defined by us, with the rationale that we should segment at each intersection. Whether you use this method or divide at some set interval like every 100 metres is up to you, but a decision made and justified is usually better than relying on defaults, such as the segments from OSM.
Let’s plot the new segments to see if they correspond to intersections.
ggplot() +
geom_sf(data = tr_intersects, lwd = 0.5) +
geom_sf(data = tr_sections,
aes(colour = as.character(section)),
lwd = 1.5, alpha = 0.8) +
theme_void() + theme(legend.position = "none")
This looks good. Now we can move to the next step and link our shoplifting incidents to these segments.
Subsubsection 8.3.2.2 Link events to street segments
To link the shoplifting incidents, first we should filter those crimes which will be relevant. For this we build a 400-metre buffer around the road, and include only those shoplifting incidents which fall within this buffer (for more about buffers, see Chapter 2 Basic Geospatial Operations in R).
tr_buffer <- st_buffer(telegraph_rd_u, 400)
# select shoplifting incidents in town centre
tr_shoplifting <- st_intersects(tr_buffer, tc_shoplifting)
tr_shoplifting <- tc_shoplifting[unlist(tr_shoplifting),]
The strength of street profiles comes out in comparing different sources of data, so let’s split our shoplifting incidents by season. Let’s compare summer and winter.
# split seasonally (to compare later) let's focus on winter and summer
summer_sl <- tr_shoplifting %>%
filter(month %in% c("2019-06", "2019-07", "2019-08"))
winter_sl <- tr_shoplifting %>%
filter(month %in% c("2019-12", "2020-01", "2020-02"))
Then, the steps for linking the crimes are the same as we followed for hot routes above, using the
st_nearest_feature() function.
# attach summer shoplifting incidents
nearest_segments_summer <- st_nearest_feature(summer_sl, tr_sections)
nearest_freq_summer <- as.data.frame(table(nearest_segments_summer))
nearest_freq_summer <- nearest_freq_summer %>%
mutate(nearest_segments_summer = as.numeric(
as.character(
nearest_freq_summer$nearest_segments_summer
)
)) %>%
rename(summer_sl = Freq)
tr_sections <- left_join(tr_sections,
nearest_freq_summer,
by = c("section" = "nearest_segments_summer")) %>%
mutate(summer_sl = replace_na(summer_sl, 0))
# repeat for the winter
nearest_segments_winter <- st_nearest_feature(winter_sl, tr_sections)
nearest_freq_winter <- as.data.frame(table(nearest_segments_winter))
nearest_freq_winter <- nearest_freq_winter %>%
mutate(nearest_segments_winter = as.numeric(
as.character(
nearest_freq_winter$nearest_segments_winter
)
)) %>%
rename(winter_sl = Freq)
tr_sections <- left_join(tr_sections,
nearest_freq_winter,
by = c("section" = "nearest_segments_winter")) %>%
mutate(winter_sl = replace_na(winter_sl, 0))
Similar to how we did with hot routes, we can carry out a visual check to make sure they linked OK. We can also try to compare the two seasons on these side-by-side maps.
p1 <- ggplot() +
geom_sf(data = tr_sections, aes(colour = summer_sl), lwd = 0.5) +
theme_void() +
scale_colour_gradient2(name = "Shoplifting in summer",
midpoint = 1,
low = "#2166ac", mid = "#d1e5f0", high = "#b2182b")
p2 <- ggplot() +
geom_sf(data = tr_sections, aes(colour = winter_sl), lwd = 0.5) +
theme_void() +
scale_colour_gradient2(name = "Shoplifting in winter",
midpoint = 1,
low = "#2166ac", mid = "#d1e5f0", high = "#b2182b")
gridExtra::grid.arrange(p1,p2, nrow = 1)
We can see there may be some differences between winter and summer, but it is unclear how much.
Subsubsection 8.3.2.3 Calculate a rate
This is the same process we used in the hot routes example above, in that we get a length for each segment, and then we use this to calculate a rate for summer and winter:
tr_sections$length <- st_length(tr_sections)
tr_sections$summer_rate <- as.numeric(tr_sections$summer_sl / tr_sections$length)
tr_sections$winter_rate <- as.numeric(tr_sections$winter_sl / tr_sections$length)
Subsubsection 8.3.2.4 Visualise
Finally, we reach the visualisation stage. To do this, we need to find the "Point A" location, which will serve as our starting point to travel down Telegraph Road. Most likely you will have to do this manually. In the case of a bus or railway route, you know the terminus stations, so you can use these. In the case of street segments, it might be more arbitrary. Here I have identified "section 3" as our starting point. Note that it’s not section 1 or 20, which means that the segments are not numbered sequentially. This means we will have to assign an order.
To assign this order, we can take our starting point (labelled "Start here") and for each line segment we can calculate the distance to this. The idea is that we can then use this distance to order them from nearest to furthest.
datalist <- list()
i <- 1
for(segment_id in tr_sections$section){
datalist[[i]] <- data.frame(section = segment_id,
dist_from_a = st_distance(
tr_sections %>% filter(section == 3),
tr_sections %>% filter(section == segment_id)))
i <- i + 1
}
dist_matrix <- do.call(rbind, datalist)
tr_sections <- left_join(tr_sections, dist_matrix)
# finally give our anchor point "a" a value of -1
tr_sections$dist_from_a[tr_sections$section == 3] <- -1
Now we can arrange the segments in order from Point A to Point B.
Let’s plot the summer shoplifting incidents using the street profile approach. This is a ggplot where the x-axis is the sequence of segments, and the y-axis is the crime rate we want to portray.
ggplot(tr_sections, aes(x = reorder(as.character(section),
dist_from_a),
y = summer_rate,
group = 1)) +
geom_point() +
geom_line() +
xlab("Telegraph Road") +
ylab("Shoplifting incidents") +
theme_bw() +
theme(axis.text.x = element_text(angle = 60, hjust = 1))
You might notice here that the labels are not very meaningful. We could manually recode each one to something better, or another approach is to try to get the name of the intersecting road in order to give some meaning. To do this, we can use a little loop below which will cycle through each segment, and we can find the nearest intersecting road from the
tr_intersects object.
# label the cross streets from 1 to n
x_streets <- tr_intersects %>%
mutate(xst_id = 1:nrow(.))
# loop through each segment and find the nearest intersecting road
datalist <- list()
i <- 1
for(segment_id in tr_sections$section){
datalist[[i]] <- data.frame(section = segment_id,
x_street = st_nearest_feature(
tr_sections %>%
filter(section == segment_id), x_streets))
i <- i + 1
}
# bind into a df
nearest_matrix <- do.call(rbind, datalist)
# join the intersections to the street data frame
nearest_matrix <- left_join(nearest_matrix,
x_streets %>%
dplyr::select(xst_id, name) %>%
st_drop_geometry(),
by = c('x_street' = 'xst_id'))
tr_sections <- left_join(tr_sections, nearest_matrix,
by = c("section" = "section")) %>%
mutate(name = make.unique(name))
Once this is done, we can use this label on the x-axis instead of the segment ID, to provide a little more context.
ggplot(tr_sections, aes(x = reorder(name,
dist_from_a),
y = summer_rate,
group = 1)) +
geom_point() +
geom_line() +
xlab("Telegraph Road") +
ylab("Shoplifting incidents") +
theme_bw() +
theme(axis.text.x = element_text(angle = 60, hjust = 1))
Now you may notice that there are some repeated names (e.g., "Thurstaston Road" and "Thurstaston Road.1") where the same intersection was snapped as "nearest" to two segments. In these cases the only solution is to go back to manual data cleaning, unfortunately. However, this is already a nice point from which to start.
Finally, the power of the street profile analysis comes from the ease of comparison of data across the route. For example, here we can compare shoplifting between winter and summer:
ggplot() +
geom_point(data = tr_sections, aes(x = reorder(name,
dist_from_a),
y = summer_rate, group = 1), col = "#2166ac") +
geom_line(data = tr_sections, aes(x = reorder(name,
dist_from_a),
y = summer_rate, group = 1), col = "#2166ac") +
geom_point(data = tr_sections, aes(x = reorder(name,
dist_from_a),
y = winter_rate, group = 1), col = "#b2182b") +
geom_line(data = tr_sections, aes(x = reorder(name,
dist_from_a),
y = winter_rate, group = 1), col = "#b2182b") +
scale_colour_manual(values = c("#2166ac", "#b2182b"),
labels = c("Summer", "Winter")) +
xlab("Telegraph Road") + ylab("Shoplifting incidents") + theme_bw() +
theme(axis.text.x = element_text(angle = 60, hjust = 1)) +
guides(colour = guide_legend(title = "Season"))
The analyst could also add the other two seasons of spring and autumn, or compare multiple sources of data about the same thing to identify where there might be areas of underreporting in certain sources. For example, I used this to map fare evasion along London bus routes from three different data sources. Similarly, we could compare different crime types along the road, to see if robbery also peaks in these areas, or maybe elsewhere. The possibilities are many, and this is where the strength of this method is evident, over a map, where only one variable at one time can be displayed.
