Search code examples
rnetwork-programmingroutesr-sfpoints

sf and networks in R : create an edgelist from distinct linestrings and points sf objects


I've got an sf object of nodes (stops) and an other of linestrings (routes).


# toy example 

## nodes
p1 = st_point(c(7, 51))
p2 = st_point(c(7, 52))
p3 = st_point(c(7, 53))
p4 = st_point(c(8, 52))
nodes = st_as_sf(st_sfc(p1, p2, p3,p4, crs = 4326))



## routes

e1 = st_cast(st_union(p1,p3), "LINESTRING")
e2 = st_cast(st_union(p1,p4), "LINESTRING")
e3 = st_cast(st_union(p3,p4), "LINESTRING")
lines = st_as_sf(st_sfc(e1, e2, e3, crs = 4326))


how to get an edgelist of route sections that directly connect two nodes?

#Desired output

from | to
p1   | p2
p2   | p3
p1   | p4
p3   | p4

Here there is a line between p1 and p3 but p2 is in the middle so there are 2 edges between p1-p2 and p2-p3

I know that the sfnetwork package can construct network with linestrings or with points, but how can I create a spatial network with the intersection of lines and points ?


Solution

  • Not sure of what you are looking for but I give it another try as a follow-up to your comment!! So, please find below a fully edited reprex using sf, sfnetworks and dplyr libraries.

    Reprex

    • STEP 1: Create a network with your points/nodes p1, p3 and p4
    library(sf)
    library(sfnetworks)
    library(dplyr)
    
    # toy example 
    p1 = st_point(c(7, 51))
    p3 = st_point(c(7, 53))
    p4 = st_point(c(8, 52))
    nodes = st_as_sf(st_sfc(p1, p3, p4, crs = 4326))
    nodes$names <- c("p1", "p3", "p4") # add the name of nodes
    
    
    ## routes
    e1 = st_cast(st_union(p1,p3), "LINESTRING")
    e2 = st_cast(st_union(p1,p4), "LINESTRING")
    e3 = st_cast(st_union(p3,p4), "LINESTRING")
    lines = st_as_sf(st_sfc(e1, e2, e3, crs = 4326))
    lines$from  <-  c("p1", "p1", "p3")
    lines$to  <-  c("p3", "p4", "p4")
    
    
    # Create the network
    network <- sfnetwork(nodes, lines, node_key = "names")
    #> Checking if spatial network structure is valid...
    #> Spatial network structure is valid
    
    
    # What the network looks like:
    network
    #> # A sfnetwork with 3 nodes and 3 edges
    #> #
    #> # CRS:  EPSG:4326 
    #> #
    #> # A directed acyclic simple graph with 1 component with spatially explicit edges
    #> #
    #> # Node Data:     3 x 2 (active)
    #> # Geometry type: POINT
    #> # Dimension:     XY
    #> # Bounding box:  xmin: 7 ymin: 51 xmax: 8 ymax: 53
    #>             x names
    #>   <POINT [°]> <chr>
    #> 1      (7 51) p1   
    #> 2      (7 53) p3   
    #> 3      (8 52) p4   
    #> #
    #> # Edge Data:     3 x 3
    #> # Geometry type: LINESTRING
    #> # Dimension:     XY
    #> # Bounding box:  xmin: 7 ymin: 51 xmax: 8 ymax: 53
    #>    from    to                x
    #>   <int> <int> <LINESTRING [°]>
    #> 1     1     2     (7 51, 7 53)
    #> 2     1     3     (7 51, 8 52)
    #> 3     2     3     (7 53, 8 52)
    
    • STEP 2: Add a supplementary node (i.e. p2) to the 'network' object
    # Create a 'sf' object for point 2 'p2'
    p2 = st_point(c(7, 52))
    p2_sf <- st_as_sf(st_sfc(p2, crs = 4326))
    p2_sf$names <- "p2"
    
    # Add 'p2' to the network and get the 'new_network' object
    new_network <- st_network_blend(network, p2_sf)
    
    
    # Cleaning the 'new_network' object
    new_network %>% 
      activate("nodes") %>% 
      mutate(names = coalesce(names.x, names.y)) %>% 
      arrange(., names) %>%
      select(names,x) -> new_network
    
    • STEP 3: Create an sf object with the desired result
    new_network %>% 
      activate("edges") %>% 
      st_as_sf() %>% 
      mutate(from = paste0("p", from), to = paste0("p", to))
    
    #> Simple feature collection with 4 features and 2 fields
    #> Geometry type: LINESTRING
    #> Dimension:     XY
    #> Bounding box:  xmin: 7 ymin: 51 xmax: 8 ymax: 53
    #> Geodetic CRS:  WGS 84
    #> # A tibble: 4 x 3
    #>   from  to                   x
    #> * <chr> <chr> <LINESTRING [°]>
    #> 1 p1    p2        (7 51, 7 52)
    #> 2 p2    p3        (7 52, 7 53)
    #> 3 p1    p4        (7 51, 8 52)
    #> 4 p3    p4        (7 53, 8 52)
    

    Created on 2021-12-05 by the reprex package (v2.0.1)