Snap points to line in order in R - r

Question

I have a set of GPS points and a linestring (representing a bus line) where the GPS points should belong to (both are ordered). So I used a function to snap the points to the linestring:
library(dplyr)
library(sf)
library(readr)
# Function to snap points to the closest line
snap_points_to_line <- function(points, line) {
# alinhar as pradas gps com a linha
points_align <- st_nearest_points(points, line) %>%
st_cast("POINT")
# pegar so os pontos pares
points_new_geometry <- points_align[c(seq(2, length(points_align), by = 2))]
points_align_end <- points %>%
st_set_geometry(points_new_geometry)
}
# GPS Points
gps <- structure(list(id = 1:11,
lon = c(-38.477035, -38.477143, -38.478701,
-38.479795, -38.480923, -38.481078,
-38.481885, -38.484545, -38.486156,
-38.486813, -38.486506),
lat = c(-3.743078, -3.743019, -3.742566,
-3.742246, -3.741844, -3.741853,
-3.741596, -3.740711, -3.740076,
-3.739399, -3.73886)),
class = "data.frame",
row.names = c(NA,-11L))
gps
id lon lat
1 1 -38.47704 -3.743078
2 2 -38.47714 -3.743019
3 3 -38.47870 -3.742566
4 4 -38.47980 -3.742246
5 5 -38.48092 -3.741844
6 6 -38.48108 -3.741853
7 7 -38.48188 -3.741596
8 8 -38.48454 -3.740711
9 9 -38.48616 -3.740076
10 10 -38.48681 -3.739399
11 11 -38.48651 -3.738860
# Download line
line <- read_rds(gzcon(url("https://github.com/kauebraga/dissertacao/raw/master/junk/line_so.rds")))
# Make snap
gps_snap <- snap_points_to_line(gps %>% st_as_sf(coords = c("lon", "lat"), crs = 4326), line)
The snap works fine most of the time. But there are some cases where the bus line makes a U turn and some points are snapped to the wrong side of the road because GPS position may have an error. In the figure below, the three points on the south side of the road should be on the north side:
How can I guarantee that the GPS points are snapped to the correct side of the road? Both the GPS points and linestring are in the same order (if you st_cast(line, "POINT) it will give points that grow together with the GPS) , so I hope there should be a way to address that (I don't know how!).
Any help using sf or other spatial tools in R would be much appreciated. Thanks!

Answer 1

Set up the data
library(sf)
library(dplyr)
library(readr)
library(rgeos)
# GPS Points
gps <- structure(list(id = 1:11,
lon = c(-38.477035, -38.477143, -38.478701,
-38.479795, -38.480923, -38.481078,
-38.481885, -38.484545, -38.486156,
-38.486813, -38.486506),
lat = c(-3.743078, -3.743019, -3.742566,
-3.742246, -3.741844, -3.741853,
-3.741596, -3.740711, -3.740076,
-3.739399, -3.73886)),
class = "data.frame",
row.names = c(NA,-11L))
# convert to sf
gps <- gps %>% st_as_sf(coords = c("lon", "lat"), crs = 4326, remove =F)
line <- read_rds(gzcon(url("https://github.com/kauebraga/dissertacao/raw/master/junk/line_so.rds")))
Define Custom Snapping Function
This function works on the logic that the correct road segment to snap to is the one which requires the shortest distance to travel to along the linestring (network distance) from the previous point.
It does the following:
Each point is buffered by a given tolerance (in metres so we have converted to a metre CRS for your area)
The line is then intersected with our buffer. This will leave two sections of road where the traffic goes both ways, and one otherwise. This is illustrated below:
We now have two options to snap to in some cases, so we initially snap to both:
We chose one of the unambiguous points (only one snap option) as the reference point and calculate the distance along the network to the snap options for the next id.
For each point id, the one with the lowest network distance from the previous id will be the one we want.
Having found the correct point id, we then set this as the new reference point and repeat from step 4.
custom_snap <- function(line, points, tolerance, crs = 29194) {
points <- st_transform(points, crs)
line <- st_transform(line, crs)
# buffer the points by the tolerance
points_buf <- st_buffer(points, 15)
# intersect the line with the buffer
line_intersect <- st_intersection(line, points_buf)
# convert mutlinestrings (more than one road segment) into linestrings
line_intersect <- do.call(rbind,lapply(1:nrow(line_intersect),function(x){st_cast(line_intersect[x,],"LINESTRING")}))
# for each line intersection, calculate the nearest point on that line to our gps point
nearest_pt <- do.call(rbind,lapply(seq_along(points$id), function(i){
points[points$id==i,] %>% st_nearest_points(line_intersect[line_intersect$id==i,]) %>% st_sf %>%
st_cast('POINT') %>% mutate(id = i)
}))
nearest_pt<- nearest_pt[seq(2, nrow(nearest_pt), by = 2),] %>%
mutate(option = 1:nrow(.))
# find an unambiguous reference point with only one snap option
unambiguous_pt <- nearest_pt %>%
group_by(id) %>%
mutate(count = n()) %>%
ungroup() %>%
filter(count == 1) %>%
slice(1)
# calculate network distance along our line to each snapped point
dists <- rgeos::gProject(as(line,'Spatial'), as(nearest_pt,'Spatial'))
# join back to nearest points data
dists <- nearest_pt %>% cbind(dists)
# we want to recursively do the following:
# 1. calculate the network distance from our unambiguous reference point to the next id point in the data
# 2. keep the snapped point for that id that was closest *along the network* to the previous id
# 3. set the newly snapped point as our reference point
# 4. repeat
# get distances from our reference point to the next point id
for(i in unambiguous_pt$id:(max(dists$id)-1)){
next_dist <- which.min(abs(dists[dists$id== i +1,]$dists - dists[dists$id== unambiguous_pt$id,]$dists ))
next_option <- dists[dists$id== i +1,][next_dist,]$option
nearest_pt <- nearest_pt %>% filter(id != i+1 | option == next_option)
unambiguous_pt <- nearest_pt %>% filter(id ==i+1 & option == next_option)
dists <- nearest_pt %>% cbind(dists = rgeos::gProject(as(line,'Spatial'), as(nearest_pt,'Spatial')))
}
# and in the reverse direction
for(i in unambiguous_pt$id:(min(dists$id)+1)){
next_dist <- which.min(abs(dists[dists$id== i -1,]$dists - dists[dists$id== unambiguous_pt$id,]$dists ))
next_option <- dists[dists$id== i -1,][next_dist,]$option
nearest_pt <- nearest_pt %>% filter(id != i-1 | option == next_option)
unambiguous_pt <- nearest_pt %>% filter(id ==i-1 & option == next_option)
dists <- nearest_pt %>% cbind(dists = rgeos::gProject(as(line,'Spatial'), as(nearest_pt,'Spatial')))
}
# transform back into lat/lng
snapped_points <- nearest_pt %>%
st_transform(4326)
return(snapped_points)
}
Calculate which line to snap to
gps_snap <- custom_snap(line, gps, 15) %>%
cbind(st_coordinates(.))
Plot results in leaflet
library(leaflet)
# get line coords
line_coords <- line %>%
st_coordinates(.)
# plot in leaflet
leaflet() %>%
leaflet::setView(lng = -38.4798, lat = -3.741829, zoom = 18) %>%
addProviderTiles('CartoDB.Positron') %>%
addPolylines(lng = line_coords[,'X'], lat = line_coords[,'Y']) %>%
addCircles(lng = gps$lon, lat = gps$lat, radius = 3, color ='red') %>%
addCircles(lng = gps_snap$X, lat = gps_snap$Y, col ='green', radius = 4)
Green represents the snapped points, red represents the original GPS points. They are now snapped to the correct side of the road.