Add new node to SpatialLinesNetwork

[rafapereirabr]

How can one use a SpatialPointsDataFrame do add a new node to a SpatialLinesNetwork ?

context of my problem: I have a shapefile of a bus route and another shapefile of bus stops. I want to calculate the distance between stops along the bus route. Ideally, each stop would be a node and I would use stplanr::sum_network_routes() to calculate the distance between them. The problem is that when I convert the bus route into a SpatialLinesNetwork the network only has a few nodes far from each other.

reproducible dataset:

# load library and data
  library(stplanr)
  data(routes_fast)

# convert SpatialLinesDataFrame into  SpatialLinesNetwork
  rnet <- overline(routes_fast, attrib = "length")
  SLN <- SpatialLinesNetwork(rnet)

# identify nodes
  sln_nodes = sln2points(SLN)

# Here is a bus stop which should be added as a node
  new_point <- SpatialPointsDataFrame(coords = cbind(-1.535, 53.809), data= data.frame(id="new"))

# plot
  plot(SLN, col = "gray")                 # network
  plot(sln_nodes, col="red", add = TRUE)  # nodes
  plot(new_point, add=T, col="blue")      # stop to be added as a new node

ps. I've asked this question on SO and Robin asked to share it here as well

[richardellison]

The issue here is that the routing done on a SpatialLinesNetwork (and the network created from it) is generated from the end points of each line (the nodes), rather than the intermediate coordinates along the line. If you want to add a new node to your network, you need to split your existing SpatialLinesDataFrame at the node then recreate the SpatialLinesNetwork.

I have done something similar before (see #92). I'll find where I saved the code for that so you can see how it works.

[Robinlovelace]

Could you provide an example of this? Could add it to the route network vignette - I think there is scope for this. Heads-up @rafapereirabr finally picking up on this. Any further updates your end?

[Robinlovelace]

For posterity, see here: https://docs.ropensci.org/stplanr/articles/stplanr-route-nets.html#adding-new-nodes

I've documented quite a low level solution. In the future there's definitely scope for creating a function to do this work.

[Robinlovelace]

Heads-up @agila5, the link above should help with the roundabout issue. To be discussed!

[rafapereirabr]

Hi Robin! thanks. It looks great. I think it would be good to have a function to make this solution more easily applicable to other cases. I've worked on your code to propose the following function. (see reproducible test below)

function

add_node_to_network <- function(route_network, point){
                           
                        # node coordinates
                          pmat =  matrix(st_coordinates(point), ncol = 2)
                        
                        # network coordinates
                          rnet_coordinates = sf::st_coordinates(route_network)
                         
                        # snap point to network
                          rmat = nabor::knn(data = rnet_coordinates[, 1:2], query = pmat, k = 1)
                          rnet_point_nearst_p = sf::st_sfc(sf::st_point(rnet_coordinates[rmat$nn.idx, 1:2]), crs = st_crs(route_network))
                          rnet_intersecting_p = lengths(st_intersects(route_network, rnet_point_nearst_p)) > 0
                         
                         #> although coordinates are longitude/latitude, st_intersects assumes that they are planar
                         rnet_line_near_p = route_network[rnet_intersecting_p, ]
                         rnet_lines_far_p = route_network[!rnet_intersecting_p, ]
                         rnet_new_geometry_collection = lwgeom::st_split(rnet_line_near_p, rnet_point_nearst_p)
                         rnet_new_linestrings = sf::st_cast(rnet_new_geometry_collection)
                         
                         #> Warning in st_cast.sf(rnet_new_geometry_collection): repeating attributes
                         #> for all sub-geometries for which they may not be constant
                         rnet_new = rbind(rnet_lines_far_p, rnet_new_linestrings)
                        
                         return(rnet_new)
                         }
 

data for reproducible example

# load library and data
  library(stplanr)
  library(sf)

# get road data
  data(routes_fast)
  sample_routes <- overline(routes_fast, attrib = "length") %>% st_as_sf()

# A bus stop which should be added as a new node
  p = sf::st_sf(geometry = sf::st_sfc(sf::st_point(c(-1.535, 53.809))), crs = st_crs(sample_routes))
 
# route network
 rnet = overline2(sample_routes, attrib = "length")

using the function

The function returns the original network with an additional node

# Applying function
   rnet_new <-  add_node_to_network(route_network=rnet, point=p) 

# plot network and nodes
   sln = SpatialLinesNetwork(rnet_new)
   sln_nodes = sln2points(sln)
 
   plot(rnet_new$geometry)
   plot(sln_nodes$geometry, col = "red", add = TRUE)