Local routing on a road network using stplanr in R

131 views Asked by At

I would like to calculate the shortest route on a road network between both an origin point and multiple points and between all points.

I am using osmdata to get the road network for my area and I would then like to use stplanr to calculate the distances. However, I can't create a SpatialLinesNetwork with all the roads - I assume because they are not connected? Is there a way of connecting the different road types into a single layer? If this is possible, can route_local in stplanr be used to calculate the shortest distance between one point (Origin in my example) to multiple points (Points in my example) and between all the points (in Points in my example)?

This is the code I have so far:

library(dplyr)
library(sf)
library(osmdata)
library(stplanr)

# Input data
Points <- data.frame(
ID = replicate(72, paste(sample(LETTERS, 5, replace=TRUE), collapse="")),
x = c(440605.3,440327.5,440833.7,442260.5,441453.3,440957.9,441535.5,441209.3,440679.3,440514.1,442210.7,440844.9,440529.3,
440917.1,442072.9,440839.9,440519.5,440219.6,441537.1,441000.2,441767.0,440637.7,441638.0,441049.4,440682.9,440879.3,
440305.4,440379.2,441083.3,442062.8,442269.6,442241.2,442105.1,441805.5,440835.9,442135.3,441721.2,442109.9,442265.8,
440601.6,440815.2,442271.3,442250.1,440647.5,440376.0,440360.9,440162.3,441304.8,440549.5,440749.2,440617.5,442047.8,
440198.9,440473.3,442260.1,440579.9,440397.6,440743.9,440331.6,440948.2,440540.3,442065.0,441037.1,441703.2,441516.6,
442025.2,441178.3,441739.8,441378.6,440403.6,440674.5,440875.9),
y = c(114430.1,113941.9,113886.1,114033.8,115375.1,115389.1,115618.7,115331.5,115612.2,115637.2,115019.2,114576.5,114602.0,
114799.0,113878.9,113444.9,113320.6,114492.2,113637.6,114494.9,113356.4,113484.9,113571.0,113351.1,114253.4,114217.8,
114434.1,114255.2,114045.8,113627.7,113610.2,113756.9,113823.5,113613.0,113331.8,114668.2,115453.0,114000.8,113418.1,
115310.1,115151.6,114696.5,114885.8,113312.3,114855.8,115195.4,114887.0,115239.8,115042.5,113972.7,114048.5,114350.9,
114089.9,114186.8,114295.4,113833.0,113690.2,114842.9,113465.0,113649.2,113591.4,114121.3,115240.1,115774.5,115858.3,
115622.9,115575.7,113506.3,113332.3,114743.6,115147.7,113716.7)
) %>% st_as_sf(coords = c("x", "y"), crs = 27700)

Origin <- data.frame(
ID = "START",
x = c(441889),
y = c(113756)
) %>% st_as_sf(coords = c("x", "y"), crs = 27700)

# OSM roads
Roads <- opq(bbox =  st_bbox(Points %>% st_transform(., crs=4326) )) %>% 
add_osm_feature(key = 'highway',
value = c ("motorway", "motorway_link","trunk","trunk_link","primary","primary_link","secondary","secondary_link","tertiary","tertiary_link","residential")) %>% 
osmdata_sf() %>%
osm_poly2line()

Roads_sf <- Roads$osm_lines %>% st_transform(., crs=27700) 

# Retain only roads that touching
Touching_roads <- st_touches(Roads_sf, sparse = FALSE)
Roads_hclust <- hclust(as.dist(!Touching_roads), method = "single")
Road_groups <- cutree(Roads_hclust, h = 0.5)
Roads_sf <- Roads_sf[Road_groups == 1, ]

# Snap points to roads
Nearest_point <- Points %>%
  mutate(
    index_of_nearest_feature = st_nearest_feature(., Roads_sf),
    nearest_feature = st_geometry(Roads_sf[index_of_nearest_feature,]),
    Nearest_point = purrr::pmap(
      list(geometry, nearest_feature),
      ~ st_nearest_points(.x, .y) %>% st_cast("POINT") %>% magrittr::extract2(2)
    )
  ) %>%
  pull(Nearest_point) %>%
  st_sfc(crs = 27700)

Points_Snapped <- Points %>% 
  st_drop_geometry() %>% 
  st_as_sf(., geometry = Nearest_point)

sln = SpatialLinesNetwork(Roads_sf)
#Warning message:
#In SpatialLinesNetwork.sf(Roads_sf) :
# Graph composed of multiple subgraphs, consider cleaning it with sln_clean_graph().
0

There are 0 answers