rr-sfstplanrsfnetwork

Creating a route from a list of points and Overlaying the route (list of points) on the road segment/ road network in R


I have a road network shapefile and list of points. I have to create a route from the list of points and then overlay/ spatially join (integrate the attributes of points that are overlaying the road segments)

The sample road network shape file can be found here https://drive.google.com/drive/folders/103Orz6NuiWOaFoEkM18SlzFTjGYi1rju?usp=sharing

The following is the code for points with lat (x) and long (y) information. The "order" column means, the order of destinations in the route .

points <-tribble (
  ~x,~y, ~order,
  78.14358, 9.921388,1,         
78.14519,   9.921123,2,         
78.14889,   9.916954,3,         
78.14932,   9.912807,4,         
78.14346,   9.913828,5,         
78.13490,   9.916551,6,         
78.12904,   9.918782,7  
)

What I want as an output is a layer of the route joining all the points in the order as mentioned. And I also want to integrate/ do a spatial join of the route to the road segments.

Thanks in advance


Solution

  • The following answer is based on the R package sfnetworks which can be installed as follows:

    install.packages("remotes")
    remotes::install_github("luukvdmeer/sfnetworks")
    

    First of all, load packages

    library(sf)
    #> Linking to GEOS 3.8.0, GDAL 3.0.4, PROJ 6.3.1
    library(sfnetworks)
    library(tidygraph)
    

    and data. The points object is converted to sf format.

    roads <- st_read("C:/Users/Utente/Desktop/Temp/roads_test.shp") %>% st_cast("LINESTRING")
    #> Reading layer `roads_test' from data source `C:\Users\Utente\Desktop\Temp\roads_test.shp' using driver `ESRI Shapefile'
    #> Simple feature collection with 785 features and 0 fields
    #> geometry type:  MULTILINESTRING
    #> dimension:      XY
    #> bbox:           xmin: 78.12703 ymin: 9.911192 xmax: 78.15389 ymax: 9.943905
    #> geographic CRS: WGS 84
    points <- tibble::tribble (
      ~x,~y, ~order,
      78.14358, 9.921388,1,         
      78.14519,   9.921123,2,         
      78.14889,   9.916954,3,         
      78.14932,   9.912807,4,         
      78.14346,   9.913828,5,         
      78.13490,   9.916551,6,         
      78.12904,   9.918782,7  
    )
    points <- st_as_sf(points, coords = c("x", "y"), crs = 4326)
    

    Plot network and points (just to understand the problem a little bit better)

    par(mar = rep(0, 4))
    plot(roads, reset = FALSE)
    plot(points, add = TRUE, cex = (1:7)/1.5, col = sf.colors(7), lwd = 4)
    

    Convert roads to sfnetwork object

    network <- as_sfnetwork(roads, directed = FALSE)
    

    Subdivide edges and select the main component. Check https://luukvdmeer.github.io/sfnetworks/articles/preprocess_and_clean.html for more details.

    network <- network %>% 
      convert(to_spatial_subdivision, .clean = TRUE) %>% 
      convert(to_components, .select = 1, .clean = TRUE) %E>% 
      mutate(weight = edge_length())
    

    Now I want to estimate the shortest paths between each pair of consecutive points. sfnetwork does not support many-to-many routing, so we need to define a for-loop. If you need to repeat this operation for several points, I think you should check the R package dodgr.

    routes <- list()
    for (i in 1:6) {
      path <- st_network_paths(
        network, 
        from = st_geometry(points)[i], 
        to = st_geometry(points)[i + 1]
      )
      routes[[i]] <- path 
    }
    

    Extract the id of the edges that compose all shortest paths

    idx <- unlist(pull(do.call("rbind", routes), edge_paths))
    

    Hence, if you want to extract the edges from the original network

    network_shortest_path <- network %E>% slice(idx)
    roads_shortest_path <- network_shortest_path %E>% st_as_sf() 
    

    Plot network and points

    par(mar = rep(0, 4))
    plot(roads, reset = FALSE)
    plot(st_geometry(roads_shortest_path), add = TRUE, col = "darkgreen", lwd = 4)
    plot(points, add = TRUE, cex = (1:7)/1.5, col = sf.colors(7), lwd = 4)
    

    Created on 2021-03-07 by the reprex package (v0.3.0)