Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

match points to graph using line intersection #103

Closed
mpadge opened this issue Sep 2, 2019 · 25 comments
Closed

match points to graph using line intersection #103

mpadge opened this issue Sep 2, 2019 · 25 comments
Labels
enhancement New feature or request

Comments

@mpadge
Copy link
Member

mpadge commented Sep 2, 2019

Current match_points_to_graph() just matches to nearest graph vertex. This could be improved by finding the closest edge to a matched point, then choosing the closest vertex of that edge. This extends from suggestions of @JimShady in stplanr issue#331. Implementing this will require a custom line intersection routine.

@mpadge
Copy link
Member Author

mpadge commented Sep 23, 2019

Cross ref this additional stplanr issue

@mpadge mpadge pinned this issue Oct 29, 2019
@mpadge mpadge added this to TODO v0.3.0 in version 0.2-0.3 Oct 10, 2021
@mpadge mpadge added the enhancement New feature or request label Oct 28, 2021
@mpadge
Copy link
Member Author

mpadge commented Nov 29, 2021

Relevant Stack Overflow discussion here.

@mpadge
Copy link
Member Author

mpadge commented Aug 11, 2022

Those commits add the required functionality, and introduce a breaking change:
https://github.com/ATFutures/dodgr/blob/5fd8b4f458c84c8e72ce4c5cd7c1941a80b6975c/NEWS.md?plain=1#L3-L6

Only remaining task is to add another function to insert new points/vertices in the network, as with ropensci/stplanr/issues/237

@mpadge
Copy link
Member Author

mpadge commented Aug 11, 2022

library (dodgr)
packageVersion ("dodgr")
#> [1] '0.2.14.90'

graph <- weight_streetnet (hampi, wt_profile = "foot")
dim (graph)
#> [1] 6813   15

verts <- dodgr_vertices (graph)
x11 ()
par (mfrow = c (1, 2))
plot (NULL, xlim = range (verts$x), ylim = range (verts$y))
segments (graph$from_lon, graph$from_lat, graph$to_lon, graph$to_lat)

set.seed (2)
npts <- 10
xy <- data.frame (
    x = min (verts$x) + runif (npts) * diff (range (verts$x)),
    y = min (verts$y) + runif (npts) * diff (range (verts$y))
)
points (xy$x, xy$y, pch = 19, col = "red")

graph <- add_nodes_to_graph (graph, xy)
dim (graph)
#> [1] 6833   15

plot (NULL, xlim = range (verts$x), ylim = range (verts$y))
segments (graph$from_lon, graph$from_lat, graph$to_lon, graph$to_lat)
points (xy$x, xy$y, pch = 19, col = "red")

Created on 2022-08-11 by the reprex package (v2.0.1)

Adding 10 points creates 20 new edges, because each one is duplicated in bi-directional form.


Concluding notes

Routines currently presume street networks with EPSG4326 only; the matching-by-perpendicular-intersection routines are applied directly to projected coordinates, which merely presumes non-planarity to be negligible (so presumes graphs cover relatively small areas), and final distances are geodesic. Can revisit and modify later if this routine starts being used more widely.

@mpadge
Copy link
Member Author

mpadge commented Aug 31, 2022

Re-opening to add ability to return actual distances to nearest edge. These distances can be very useful for routing tasks, to construct some measure of weighted distance to some kinds of points of attraction (or whatever).

@mpadge
Copy link
Member Author

mpadge commented Sep 2, 2022

Those commits add the distance to the output of the C++function. It's not yet used, but can be added directly to the R output from there.

###TODO

  • Return actual geodesic distance, not current geometric and therefore incorrect distance

Not sure the best way to do that? Likely get the actual point of intersection and return the coordinates of that so that a final application in R of ˋgeodistˋ will then give the correct distance. That will require tweaking the C++ code to get the actual coordinates of the intersection point as well as the distances.

@mpadge
Copy link
Member Author

mpadge commented Sep 2, 2022

That commit adds the geometric distances. Just need to run a few test cases to make sure everything is okay, and then modify the return value to include those distances.

@xiaofanliang
Copy link

xiaofanliang commented Apr 11, 2023

What is the current status of this issue? I was looking for something that allow me to similar function as st_network_blend() in sfnetworks package https://luukvdmeer.github.io/sfnetworks/reference/st_network_blend.html and this sounds close. I want to add a vertex to the graph network (road network in my case) that is a perpendicular / closest distance match from a given point (e.g., centroids of a building).

The current dodgr_dists and match_points_to_graph seem to still map given points to the closest EXISTING vertices on the graph, which creates problems in routing. Based on your example above, it seems like I need to apply add_nodes_to_graph() to the graph before running dodgr_dists. However, add_nodes_to_graph() does not add a node perpendicular to the graph as I expected.

The graph plotted with and without using add_nodes_to_graph() is illustrated as the first and second image below: the red points are the start and end points. The difference is that graph has two more edges (which was explained above for bi-directional) for each node I want to add. I was expecting something that looks like the third image below.

Screen Shot 2023-04-11 at 12 20 42 AM
Screen Shot 2023-04-11 at 12 21 23 AM
Screen Shot 2023-04-11 at 12 20 42 AM

The current way to add node to a graph creates a weird effect on my routing and makes my start and end points (which are centroids of buildings) to be part of the graph (which they are not.. the graph is the road network).

I realized this will work well if the vertex-to-be-added is already ON the graph (then the current mode makes perfect sense). Is there an easy way to find the closest matching point on the graph if the given point (e.g., in my case, building centroids) is not on the graph? I need to do this for many pairs of ODs.

In case you need it, this is the code for making the graphics above

nodes_to_add = rbind(start_point, end_point) #only have x, y columns with two rows 
plot(NULL, xlim = range(nodes_to_add$x), ylim =range(nodes_to_add$y))
segments(graph$from_lon, graph$from_lat, graph$to_lon, graph$to_lat)
points(nodes_to_add$x, nodes_to_add$y, pch = 19, col = "red")

test <- add_nodes_to_graph(graph, nodes_to_add)
segments(test$from_lon, test$from_lat, test$to_lon, test$to_lat)
points(nodes_to_add$x, nodes_to_add$y, pch = 19, col = "red")

@mpadge
Copy link
Member Author

mpadge commented Apr 13, 2023

Thanks @xiaofanliang, short answer is yes, that's all possible, but not yet sufficiently well documented. I'll get a longer answer to you sometime next week

@mpadge
Copy link
Member Author

mpadge commented Apr 17, 2023

@xiaofanliang Main problem was that the function docs had not been updating properly for quite some time. Updated version of match_pts_to_graph() should have what you want. Feel free to ask any more questions.

@xiaofanliang
Copy link

@mpadge Thanks! I will experiment with my codes.

@xiaofanliang
Copy link

xiaofanliang commented May 7, 2023

@mpadge I tried it out with an example with the latest dev branch download of dodgr, using the default hampi india dataset. The result is confusing to me. I am looking for results that tell me the closest perpendicular points on the graph, rather than the closest perpendicular edges on the graph.

Here I attached a replicable example to work with. This is what the data looks like. I would like to find the closest perpendicular points on the graph for reach red dots.

hampi <- dodgr_streetnet ("hampi india")
cols <- c ("osm_id", "highway", "oneway", "geometry")
hampi <- hampi [, which (names (hampi) %in% cols)]
net <- weight_streetnet (hampi, wt_profile = "motorcar")

#from_x <- min (net$from_lon) + runif (10) * diff (range (net$from_lon))
x <- c(76.48706,76.48190,76.47498,76.47130,76.39222,76.39313,76.45629,76.45122,76.40285,76.42479)
#from_y <- min (net$from_lat) + runif (10) * diff (range (net$from_lat))
y <- c(15.34002,15.32931,15.35103,15.34152,15.31357,15.30398,15.32568,15.35853,15.32874,15.34179)

nodes_to_add = as.data.frame(cbind(x,y))
plot(NULL, xlim = range(nodes_to_add$x), ylim =range(nodes_to_add$y))
segments(net$from_lon, net$from_lat, net$to_lon, net$to_lat)
points(nodes_to_add$x, nodes_to_add$y, pch = 19, col = "red")

image

If I run match_pts_to_graph() as suggested here, it returns row indices (I believe) of the closest perpendicular edges in the net graph to the red points. This does not really solve my problem of finding the closest perpendicular points on the graph.

match_pts_to_graph(net, nodes_to_add)

#1575 1641  183  835 1381 1381  375 1059 2369 2411

@mpadge
Copy link
Member Author

mpadge commented May 8, 2023

@xiaofanliang I guess by "perpendicular points" you mean the actual points of intersection between the pependicular line and the closest edge? Those points of intersection are calculated internally, but not returned by the function. I guess it would be useful to have a way to access those. I could just add two extra columns when distances = TRUE of the coordinates of the points. I'll post example code here when that's done.

@mpadge
Copy link
Member Author

mpadge commented May 8, 2023

library (dodgr)
packageVersion ("dodgr")
#> [1] '0.2.20.22'
graph <- weight_streetnet (hampi, wt_profile = "foot")
v <- dodgr_vertices (graph)
# A random point:
set.seed (1L)
n <- 10L
xy <- apply (v [, c ("x", "y")], 2, function (i) runif (n, min = min (i), max = max (i)))
d <- match_pts_to_graph (graph, xy, distances = TRUE)
print (d)
#>    index   d_signed        x        y
#> 1   3395    0.00000 76.42341 15.31717
#> 2   3395    0.00000 76.42341 15.31717
#> 3   5271    0.00000 76.44288 15.34326
#> 4   6325    0.00000 76.48064 15.32658
#> 5   6225 -623.02542 76.39593 15.35226
#> 6   2469    0.00000 76.47957 15.33146
#> 7     31    0.00000 76.48381 15.33999
#> 8   3247    0.00000 76.45306 15.36033
#> 9   3539    0.00000 76.44780 15.32178
#> 10  6201   54.05596 76.38011 15.34666

library (sf)
#> Linking to GEOS 3.11.2, GDAL 3.6.4, PROJ 9.2.0; sf_use_s2() is TRUE
plot (hampi$geometry)
points (xy, col = "orange")
points (d [, c ("x", "y")], col = "red", pch = 19)
segments (xy [, 1], xy [, 2], d$x, d$y, col = "red")

Created on 2023-05-08 with reprex v2.0.2

(Note that intersection lines will only look perpendicular when the plot rectangle is truly square, which is almost never will be.)

@xiaofanliang
Copy link

@mpadge Yes! That is what I am looking for. It seems like the new updates have not been integrated in the dev version yet so I cannot test it out further on my end. Thanks for the speedy updates again.

I can explain my motivation for asking for this functionality a bit more and maybe it will help you figure out what is the best way to implement this. My start and end points for routing are building centroids. I would like to contract my graph (road networks) via dodgr_contract_graph to save routing time, but contracting the graph also means removing a lot of graph vertices. When I calculate the distance of the path/route on the contracted graph, the building centroids will be matched to fewer vertices and thus have lower resolution/accuracy on distance calculation. I want to find the perpendicular intersection points so that I can ask dodgr_contract_graph to keep these vertices when contracting the graph so that I can improve routing time while keeping the distance accuracy. This method can become inefficient when I have too many building centroids to match to the graph, which essentially creates way more perpendicular vertices than those I removed through contracting the graph. I am still thinking what will be the best way to approach it.

@mpadge
Copy link
Member Author

mpadge commented May 8, 2023

@xiaofanliang That's all on main branch now, so good for you to use straight away.

Thanks for explaining your general use case. I face exactly that issue a lot too, but in my case it's always sufficient just to match to vertices and ensure those are passed as the verts param to dodgr_contract_graph() to keep them. My data are almost exclusively urban, and edge distances generally average 10-20m, which is enough accuracy for me. So i have not yet developed a full workflow along the lines you are clearly looking for. I'd be very keen to work with you on getting that happening if you want - let me know.

@mpadge
Copy link
Member Author

mpadge commented May 8, 2023

Sorry, I hadn't pushed the commit. It's now up.

@xiaofanliang
Copy link

xiaofanliang commented May 9, 2023

I experimented today with hampi data with a workflow comparing distance calculation on uncontracted graph vs. contracted graph + intersection points. There are more to fix than I thought, so I give up on using the intersection points for now. I still share the codes below in case you want to dig in further in the future.

In short, I use add_nodes_to_graph() to add the intersection points returned by d to the contracted graph. This step is fine. I returned the number of vertices and number of rows in graph and they increase according to expectations.

However, when I calculate distance, the distances on the uncontracted graph and contracted graph are very different, even if I use the same starting/ending points (i.e., intersection points returned by d). In fact, the uncontracted graph gives more accurate distances. There may be two reasons:

  • the contracted graph reduces vertices and thus the paths are less realistic. This is independent of whether I add the intersection points or not.
  • somehow, and I don't know why, the path between two intersection points on the contracted graph SOMETIMES includes extra edges that should not be in the distance calculation (see my image below)
library(dodgr)
library(sf)
library(tidyverse)
library(tmap)

graph <- weight_streetnet (hampi, wt_profile = "foot")
graph <- graph[graph$component == 1, ]
v <- dodgr_vertices (graph)
set.seed (2L)
n <- 10L
xy <- apply (v [, c ("x", "y")], 2, function (i) runif (n, min = min (i), max = max (i)))
d <- match_pts_to_graph (graph, xy, distances = TRUE)
print (d)

#     index   d_signed       x        y
# 1   2499    0.00000 76.43668 15.32657
# 2    537    0.00000 76.47210 15.31308
# 3   4009  -26.51686 76.46285 15.33379
# 4   2325    0.00000 76.43557 15.31713
# 5   3909  392.44236 76.48711 15.32174
# 6     57    0.00000 76.48639 15.33916
# 7   2433    0.00000 76.43550 15.33031
# 8   3965 -418.38177 76.47733 15.31263
# 9   1335    0.00000 76.45663 15.31841
# 10  3651    0.00000 76.46174 15.31509

# uncontracted graph summary stats
nrow(graph)
# [1] 4649
nrow(dodgr_vertices(graph))
# [1] 2270

# contract graph summary stats
graph2 = dodgr_contract_graph(graph)
nrow(graph2)
# [1] 544
nrow(dodgr_vertices(graph2))
# [1] 216

# add intersection points to contracted graphs 
graph2 = add_nodes_to_graph(graph2, d[,c('x','y')])
nrow(graph2)
# [1] 568
nrow(dodgr_vertices(graph2))
# [1] 236

# compare distances; first five rows as start points; last five rows as end points
dodgr_dists(graph, from = xy[c(1:5),], to = xy[c(6:10),], pairwise = T)

# [,1]
# [1,] 7256.453
# [2,] 7309.345
# [3,] 5008.182
# [4,] 3639.962
# [5,] 5788.260

dodgr_dists(graph2, from = d[,c('x','y')][c(1:5),], to = d[,c('x','y')][c(6:10),], pairwise = T)

# [,1]
# [1,] 6547.354
# [2,] 6635.375
# [3,] 8878.511
# [4,] 6627.632
# [5,] 5508.575

# map out path #4 because it has a big difference in distance
dp <- dodgr_paths(graph2, from = d[,c('x','y')][c(1:5),], to = d[,c('x','y')][c(6:10),], pairwise = T)
graph2_v <- dodgr_vertices(graph2)

# convert path #4 to sf geometry 
p4 <- graph2_v[match(dp[[4]] [[1]], graph2_v$id), ] %>% as.data.frame() %>% st_as_sf(coords=c('x', 'y'), crs=4326) %>% 
  mutate(temp = 1) %>% group_by(temp) %>% summarise(do_union = FALSE) %>% st_cast("LINESTRING")

# create uncontracted path #4 and converts to sf geometry 
dp_uncontracted = dodgr_paths(graph, from = xy[c(4),], to = xy[c(9),], pairwise = T)
graph_v <- dodgr_vertices(graph)
p4_uncontracted = graph_v[match(dp_uncontracted[[1]] [[1]], graph_v$id), ] %>% as.data.frame() %>% st_as_sf(coords=c('x', 'y'), crs=4326) %>% 
  mutate(temp = 1) %>% group_by(temp) %>% summarise(do_union = FALSE) %>% st_cast("LINESTRING")

# convert graph2 to sf geometry 
st_segment = function(r){st_linestring(t(matrix(unlist(r), 2, 2)))}

graph_geom = graph2
graph_geom$geometry = st_sfc(
  sapply(1:nrow(graph2), 
         function(i){
           st_segment(graph2[i,][c('from_lon', 'from_lat', 'to_lon', 'to_lat')])},
         simplify=FALSE))

# ensure the output is an sf object and set the crs 
graph_geom = graph_geom %>% st_as_sf() %>% st_set_crs(4326)

# see everything on maps
library(tmap)
tmap_mode('view')
# contracted graph
tm_shape(graph_geom) + 
  tm_lines(alpha=0.1) + 
  # original start points 
  tm_shape(data.frame(xy[c(1:5),]) %>% st_as_sf(coords=c('x', 'y'), crs=4326)) + 
  tm_symbols(col='red') + 
  # original end points 
  tm_shape(data.frame(xy[c(6:10),]) %>% st_as_sf(coords=c('x', 'y'), crs=4326)) + 
  tm_symbols(col='blue') + 
  # intersection start points 
  tm_shape(d[,c(3,4)][c(1:5),] %>% st_as_sf(coords=c('x', 'y'), crs=4326)) + 
  tm_symbols(col='orange') + 
  # intersection end points 
  tm_shape(d[,c(3,4)][c(6:10),] %>% st_as_sf(coords=c('x', 'y'), crs=4326)) + 
  tm_symbols(col='lightblue') + 
  # contracted graph road vertices
  tm_shape(graph2_v[match(dp[[4]] [[1]], graph2_v$id), ] %>% as.data.frame() %>% st_as_sf(coords=c('x', 'y'), crs=4326)) + 
  tm_symbols(size=0.1) + 
  # path 4 on contracted graph
  tm_shape(p4) + 
  tm_lines(lwd=2) + 
  # path 4 on uncontracted graph
  tm_shape(p4_uncontracted) + 
  tm_lines(lwd=1, col='green')

Screen Shot 2023-05-09 at 4 35 50 PM

@mpadge
Copy link
Member Author

mpadge commented May 10, 2023

Yep, definitely something wrong there:

library (dodgr)
graph <- weight_streetnet (hampi, wt_profile = "foot")
graph <- graph[graph$component == 1, ]
v <- dodgr_vertices (graph)
set.seed (2L)
n <- 10L
xy <- apply (v [, c ("x", "y")], 2, function (i) runif (n, min = min (i), max = max (i)))
d <- match_pts_to_graph (graph, xy, distances = TRUE)
graph2 = dodgr_contract_graph(graph)
graph2 = add_nodes_to_graph(graph2, d[,c('x','y')])

i <- c (1, 7)
dodgr_dists(graph, from = xy[i [1],], to = xy[i [2],], pairwise = T)
#>          [,1]
#> [1,] 616.9445
dodgr_dists(graph2, from = xy[i [1],], to = xy[i [2],], pairwise = T)
#>          [,1]
#> [1,] 5262.223
# dodgr_paths(graph, from = xy[i [1],], to = xy[i [2],], pairwise = T)
# dodgr_paths(graph2, from = xy[i [1],], to = xy[i [2],], pairwise = T)

p1 <- dodgr_paths(graph, from = xy[i [1],], to = xy[i [2],], pairwise = T)
v1 <- dodgr_vertices (graph)
p1 <- v1 [match (p1 [[1]] [[1]], v1$id), ]
p2 <- dodgr_paths(graph2, from = xy[i [1],], to = xy[i [2],], pairwise = T)
v2 <- dodgr_vertices (graph2)
p2 <- v2 [match (p2 [[1]] [[1]], v2$id), ]

plot (NULL, xlim = range (rbind (p1, p2)$x), ylim = range (rbind (p1, p2)$y))
lines (p1$x, p1$y, col = "red")
points (p1$x, p1$y, pch = 19, col = "red")
points (p1$x [1], p1$y [1], pch = 19, cex = 2, col = "red")
points (p1$x [nrow (p1)], p1$y [nrow (p1)], pch = 19, cex = 2, col = "orange")
lines (p2$x, p2$y, col = "lawngreen")
points (p2$x, p2$y, pch = 19, col = "lawngreen")
points (p2$x [1], p2$y [1], pch = 19, cex = 1.5, col = "lawngreen")
points (p2$x [nrow (p2)], p2$y [nrow (p2)], pch = 19, cex = 1.5, col = "blue")

Created on 2023-05-10 with reprex v2.0.2

@mpadge
Copy link
Member Author

mpadge commented May 10, 2023

That example is a poor one, because the start and end points both match on to the same vertex of the original graph. But the problem definitely lies in the add_nodes_to_graph() function. Changing the value of i <- c (1, 7) to something else shows that everything works as expected without the call to that function, but gives garbage results if graph2 is modified by add_nodes_to_graph().

@mpadge
Copy link
Member Author

mpadge commented May 10, 2023

So the problem seems to arise when multiple points submitted to add_nodes_to_graph() match on to the same graph edges. This illustrates:

library (dodgr)
graph <- weight_streetnet (hampi, wt_profile = "foot")
graph <- graph[graph$component == 1, ]
v <- dodgr_vertices (graph)
set.seed (2L)
n <- 10L
xy <- apply (v [, c ("x", "y")], 2, function (i) runif (n, min = min (i), max = max (i)))
d <- match_pts_to_graph (graph, xy, distances = TRUE)
graph2 = dodgr_contract_graph(graph)
graph2 = add_nodes_to_graph(graph2, d[,c('x','y')])

# Important note: The match_pts_to_verts call should here 
# include the intersection vertices, not the actual xy coordinates

# xy_id1 <- v$id [match_pts_to_verts (v, xy)]
xy_id1 <- v$id [match_pts_to_verts (v, d [, c ("x", "y")])]
v2 <- dodgr_vertices (graph2)
# xy_id2 <- v2$id [match_pts_to_verts (v2, xy)]
xy_id2 <- v2$id [match_pts_to_verts (v2, d [, c ("x", "y")])]

i <- c (1, 8)

# These should be the same, or almost identical, and indeed are:
v [match (xy_id1 [i [1]], v$id), ]
#>              id        x        y component    n
#> 2500 7794251384 76.43668 15.32657         1 1255
v2 [match (xy_id2 [i [1]], v2$id), ]
#>             id        x        y component   n
#> 528 OS7CwRELzG 76.43668 15.32657         1 210

# And these are also nearly the same:
v [match (xy_id1 [i [2]], v$id), ]
#>              id        x        y component    n
#> 3964 1376769158 76.47739 15.31274         1 1958
v2 [match (xy_id2 [i [2]], v2$id), ]
#>             id        x        y component   n
#> 556 mO473txWcg 76.47733 15.31263         1 228

p1 <- dodgr_paths(graph, from = xy[i [1],], to = xy[i [2],], pairwise = T)
v1 <- dodgr_vertices (graph)
p1 <- v1 [match (p1 [[1]] [[1]], v1$id), ]
p2 <- dodgr_paths(graph2, from = xy[i [1],], to = xy[i [2],], pairwise = T)
v2 <- dodgr_vertices (graph2)
p2 <- v2 [match (p2 [[1]] [[1]], v2$id), ]

plot (NULL, xlim = range (rbind (p1, p2)$x), ylim = range (rbind (p1, p2)$y))
lines (p1$x, p1$y, col = "red")
points (p1$x, p1$y, pch = 19, col = "red")
text (p1$x [1], p1$y [1], labels = "start", pos = 3, col = "red")
text (p1$x [nrow (p1)], p1$y [nrow (p1)], labels = "end", pos = 3, col = "red")
lines (p2$x, p2$y, col = "blue")
points (p2$x, p2$y, pch = 19, col = "blue")
text (p2$x [1], p2$y [1], labels = "start", pos = 3, col = "blue")
text (p2$x [nrow (p2)], p2$y [nrow (p2)], labels = "end", pos = 3, col = "blue")
points (d [, c ("x", "y")], pch = 19, col ="gray", cex = 2)

Created on 2023-05-10 with reprex v2.0.2

That excursion extends out to an additional point that matches on the same edge as the start point. It is then inadvently added to the graph in the add_nodes_to_graph() call, instead of being ignored as it should. And the first graph pasted above started and ended at those two points, which is why that failed.

@mpadge
Copy link
Member Author

mpadge commented May 10, 2023

The above commit brings us here, noting that the workflow is slightly different to the above. I think this is the appropriate workflow here, which is:

  1. Match new points to uncontracted graph
  2. Use add_nodes_to_graph() to insert the nearest penpendicular intersections of those points into that graph
  3. Find the IDs of the newly inserted vertices in that graph
  4. Contract the graph and submit those IDs as vertices to be retained in contracted version
library (dodgr)
packageVersion ("dodgr")
#> [1] '0.2.20.25'
graph <- weight_streetnet (hampi, wt_profile = "foot")
graph <- graph[graph$component == 1, ]
v0 <- dodgr_vertices (graph)
set.seed (2L)
n <- 10L
xy <- apply (v0 [, c ("x", "y")], 2, function (i) runif (n, min = min (i), max = max (i)))
d <- match_pts_to_graph (graph, xy, distances = TRUE)
graph = add_nodes_to_graph(graph, d[,c('x','y')])
v <- dodgr_vertices (graph)
v_new <- v$id [which (!v$id %in% v0$id)]
graph2 <- dodgr_contract_graph (graph, verts = v_new)

xy_id1 <- v$id [match_pts_to_verts (v, d [, c ("x", "y")])]
v2 <- dodgr_vertices (graph2)
xy_id2 <- v2$id [match_pts_to_verts (v2, d [, c ("x", "y")])]

i <- c (1, 8)
dodgr_dists(graph, from = xy_id1 [i [1]], to = xy_id1 [i [2]], pairwise = T)
#>          [,1]
#> [1,] 8162.554
dodgr_dists(graph2, from = xy_id2 [i [1]], to = xy_id2 [i [2]], pairwise = T)
#>          [,1]
#> [1,] 9085.145

p1 <- dodgr_paths(graph, from = xy_id1 [i [1]], to = xy_id1 [i [2]], pairwise = T)
v1 <- dodgr_vertices (graph)
p1 <- v1 [match (p1 [[1]] [[1]], v1$id), ]
p2 <- dodgr_paths(graph2, from = xy_id2 [i [1]], to = xy_id2 [i [2]], pairwise = T)
v2 <- dodgr_vertices (graph2)
p2 <- v2 [match (p2 [[1]] [[1]], v2$id), ]

plot (NULL, xlim = range (rbind (p1, p2)$x), ylim = range (rbind (p1, p2)$y))
segments (graph2$from_lon, graph2$from_lat, graph2$to_lon, graph2$to_lat, col = "gray")
lines (p1$x, p1$y, col = "red")
points (p1$x, p1$y, pch = 19, col = "red")
text (p1$x [1], p1$y [1], labels = "start", pos = 3, col = "red")
text (p1$x [nrow (p1)], p1$y [nrow (p1)], labels = "end", pos = 3, col = "red")
lines (p2$x, p2$y, col = "blue")
points (p2$x, p2$y, pch = 19, col = "blue")
text (p2$x [1], p2$y [1], labels = "start", pos = 3, col = "blue")
text (p2$x [nrow (p2)], p2$y [nrow (p2)], labels = "end", pos = 3, col = "blue")
points (d [, c ("x", "y")], pch = 19, col ="gray", cex = 2)
text (d [, c ("x", "y")], labels = seq_len (nrow (d)), pos = 1)

Created on 2023-05-10 with reprex v2.0.2

I think that mostly fixes it. The commit introduced a dist_tol parameter, so that new edges are only inserted if intervening vertices are more than that distance away from any existing ones. The start points in that result are still different, as are therefore the resultant distances. because they are the vertices of the two graphs which are closest to the original points of penpendicular intersection in the original graph. The first line from the blue start point follows an edge of the contracted graph that is hidden under the blue line.

That all makes sense to me, but still leaves the issue that the general workflow we want here should be able to yield identical distances from both versions of the graph, so there's still some work to be done here.

@mpadge
Copy link
Member Author

mpadge commented May 10, 2023

That commit extends the code so that new points can be directly submitted to add_nodes_to_graph(), and they are added as straight lines from input points to points of nearest penpendicular intersection, then edges bisected around those points of intersection. Now it all works, and distances are exactly equal as expected (within numerical tolerance). In the final plot, the blue lines and points overlay the red, but all start and end points are identical.

library (dodgr)
packageVersion ("dodgr")
#> [1] '0.2.20.26'
graph <- weight_streetnet (hampi, wt_profile = "foot")
graph <- graph[graph$component == 1, ]
v0 <- dodgr_vertices (graph)
set.seed (2L)
n <- 10L
xy <- apply (v0 [, c ("x", "y")], 2, function (i) runif (n, min = min (i), max = max (i)))
graph = add_nodes_to_graph(graph, xy)
v <- dodgr_vertices (graph)
v_new <- v$id [which (!v$id %in% v0$id)]
graph2 <- dodgr_contract_graph (graph, verts = v_new)

xy_id1 <- v$id [match_pts_to_verts (v, xy)]
v2 <- dodgr_vertices (graph2)
xy_id2 <- v2$id [match_pts_to_verts (v2, xy)]

i <- c (1, 8)
dodgr_dists(graph, from = xy_id1 [i [1]], to = xy_id1 [i [2]], pairwise = T)
#>          [,1]
#> [1,] 8800.232
dodgr_dists(graph2, from = xy_id2 [i [1]], to = xy_id2 [i [2]], pairwise = T)
#>          [,1]
#> [1,] 8800.232

p1 <- dodgr_paths(graph, from = xy_id1 [i [1]], to = xy_id1 [i [2]], pairwise = T)
v1 <- dodgr_vertices (graph)
p1 <- v1 [match (p1 [[1]] [[1]], v1$id), ]
p2 <- dodgr_paths(graph2, from = xy_id2 [i [1]], to = xy_id2 [i [2]], pairwise = T)
v2 <- dodgr_vertices (graph2)
p2 <- v2 [match (p2 [[1]] [[1]], v2$id), ]

plot (NULL, xlim = range (rbind (p1, p2)$x), ylim = range (rbind (p1, p2)$y))
segments (graph2$from_lon, graph2$from_lat, graph2$to_lon, graph2$to_lat, col = "gray")
lines (p1$x, p1$y, col = "red")
points (p1$x, p1$y, pch = 19, col = "red")
text (p1$x [1], p1$y [1], labels = "start", pos = 3, col = "red")
text (p1$x [nrow (p1)], p1$y [nrow (p1)], labels = "end", pos = 3, col = "red")
lines (p2$x, p2$y, col = "blue")
points (p2$x, p2$y, pch = 19, col = "blue")
text (p2$x [1], p2$y [1], labels = "start", pos = 3, col = "blue")
text (p2$x [nrow (p2)], p2$y [nrow (p2)], labels = "end", pos = 3, col = "blue")
points (xy, pch = 19, col ="gray", cex = 2)
text (xy, labels = seq_len (nrow (xy)), pos = 1)

Created on 2023-05-10 with reprex v2.0.2

Now just have to expose an additional parameter, something like intersections_only, to allow edges to be split at nearest points of intersection only, with (intersections_only = FALSE) or without (intersections_only = TRUE), where the latter adds additional edges out to coordinates of input points

@mpadge mpadge closed this as completed in d4a791e May 10, 2023
@mpadge
Copy link
Member Author

mpadge commented May 10, 2023

That commit then means the the plot immediately above is generated with

graph = add_nodes_to_graph(graph, xy, intersections_only = FALSE) # default

And the one prior to that, where the start points don't quite match up, and the distances differ, arises from

graph = add_nodes_to_graph(graph, xy, intersections_only = TRUE)

The workflow described above is then slightly simplified to one step only:

  1. Use add_nodes_to_graph() to insert new edges

With the default intersections_only = FALSE, all submitted coordinates will be transformed into terminal vertices, and so the corresponding edges will always be retained in the contracted graph. The code above can therefore also be simplified from

graph2 <- dodgr_contract_graph (graph, verts = v_new)

to

graph2 <- dodgr_contract_graph (graph)

and the lines to identify newly inserted vertices removed.

Let me know how that goes for you @xiaofanliang, and thanks for the extensive testing 👍

mpadge added a commit that referenced this issue May 10, 2023
@xiaofanliang
Copy link

xiaofanliang commented May 10, 2023

Thanks for the extensive updates as well!

Here is an example of the complete workflow. I would like to clarify when to use intersectios_only=TRUE a bit more. Going back to my case of matching building centroids to the closest intersection points and calculating distances, does that mean the start points are different from the intersection points, and thus I should set intersectios_only=TRUE? When is intersectios_only=FALSE applied? (e.g., when the intersection points are also the same as the closest vertex match?).

I notice that in the example below, when I set intersectios_only=TRUE, the distances on the contracted and uncontracted graph are almost identical (except for the 5th path), and when intersectios_only=FALSE, the distances are different. Why is this the case?

library (dodgr)
graph <- weight_streetnet (hampi, wt_profile = "foot")
graph <- graph[graph$component == 1, ]
v0 <- dodgr_vertices (graph)
set.seed (2L)
n <- 10L
xy <- apply (v0 [, c ("x", "y")], 2, function (i) runif (n, min = min (i), max = max (i)))

# experimenting intersections_only = TRUE / FALSE
graph2 = add_nodes_to_graph(graph, xy, intersections_only = TRUE)
nrow(graph)
# [1] 4649
nrow(graph2)
# [1] 4655

# compare distances; first five rows as start points; last five rows as end points
dodgr_dists(graph, from = xy[c(1:5),], to = xy[c(6:10),], pairwise = T)

# [,1]
# [1,] 7256.453
# [2,] 7309.345
# [3,] 5008.182
# [4,] 3639.962
# [5,] 5788.260

dodgr_dists(graph2, from = xy[c(1:5),], to = xy[c(6:10),], pairwise = T)

# [,1]
# [1,] 7256.453
# [2,] 7309.345
# [3,] 4953.775
# [4,] 3639.962
# [5,] 5769.843

graph2 = add_nodes_to_graph(graph, xy, intersections_only = FALSE)
nrow(graph)
# [1] 4649
nrow(graph2)
# [1] 4695

# compare distances; first five rows as start points; last five rows as end points
dodgr_dists(graph, from = xy[c(1:5),], to = xy[c(6:10),], pairwise = T)

# [,1]
# [1,] 7256.453
# [2,] 7309.345
# [3,] 5008.182
# [4,] 3639.962
# [5,] 5788.260

dodgr_dists(graph2, from = xy[c(1:5),], to = xy[c(6:10),], pairwise = T)

# [,1]
# [1,] 7743.399
# [2,] 8945.959
# [3,] 5398.671
# [4,] 4787.256
# [5,] 7370.490

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Labels
enhancement New feature or request
Projects
version 0.2-0.3
  
TODO v0.3.0
Development

No branches or pull requests

2 participants