dodgr_flows_aggregate with argument pairwise

[chinhqho]

Can I request for a new feature: pairwise = TRUE to be included in the newer version of dodgr_flows_aggregate function. Very often, I have a list of O-D pairs that I need find the shortest paths and then aggregate the paths to flows for visualising the results. Currently this function only supports multiple froms to multiple tos , giving a matrix of length(from) * length(to).

[mpadge]

@chinhqho That's a great idea, and the above commits show I've already managed to implement it. It's currently still in PR #230, which gives results like this:

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

graph <- weight_streetnet (hampi)
n <- 20
set.seed (2L)
from <- sample (graph$from_id, size = n)
to <- sample (graph$to_id, size = n)
stopifnot (!to %in% from)
flows <- runif (n)

graph0 <- dodgr_flows_aggregate (graph, from = from, to = to, flows = flows, pairwise = FALSE)
index0 <- which (graph0$flow > 0)
graph1 <- dodgr_flows_aggregate (graph, from = from, to = to, flows = flows, pairwise = TRUE)
index1 <- which (graph1$flow > 0)
message ("num flows for pairwise = (FALSE, TRUE) = (", length (index0), ", ", length (index1), ")")
#> num flows for pairwise = (FALSE, TRUE) = (772, 1299)

library (ggplot2)
dat <- data.frame (
    pairwise = c (rep (FALSE, length (index0)), rep (TRUE, length (index1))),
    flow = c (graph0$flow [index0], graph1$flow [index1])
)
ggplot (dat, aes (x = flow, colour = pairwise)) +
    geom_freqpoly (lwd = 1) +
    theme_minimal () +
    theme (
        legend.position = "inside",
        legend.position.inside = c (0.8, 0.9)
    )
#> `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

^{Created on 2024-06-05 with reprex v2.1.0}

And flow aggregation with pairwise = TRUE produces fewer non-zero flows, and edges with flows have lower values on average, as should be expected. I'll just have to implement tests and should be good to merge.

[mpadge]

Done. Let me know how you go.

[chinhqho]

Thanks heap @mpadge. I have tested the development version 0.4.0.11 which works if froms and tos are both vertex ids. However, the new dodgr_flows_aggregate function does not work if froms and tos are in xy (lat/long) coordinates. A work around solution is to use the match_pts_to_verts function. I can live with that.

remotes::install_github("UrbanAnalyst/dodgr", INSTALL_opts = '--no-lock')
library(dodgr)
library(tictoc)
packageVersion("dodgr") # ‘0.4.0.11’

verts <- dodgr_vertices(sydnet)
n <- 400
verts <- dodgr_vertices(sydnet)
orig_idx <- match_pts_to_verts(verts, xy = head(from, n), connected = FALSE) # an index into verts
dest_idx <- match_pts_to_verts(verts, xy = head(to, n), connected = FALSE) 
orig <- verts$id[orig_idx] # names of vertices
dest <- verts$id[dest_idx]

flows <- rep(1, n) # route individual trip
tic() # 100 routes take 140 seconds 
graph_f <- dodgr_flows_aggregate (sydnet, 
                                  from = orig, to = dest, 
                                  flows = flows, 
                                  pairwise = TRUE, # available in dev version
                                  norm_sums = FALSE) # to get number of trips, not density

(graph_f <- graph_f[graph_f$flow > 0, ])

dodgr_flowmap(graph_f, linescale = 5)
toc() #169 secs for 400 routes

# Then merge directed flows and convert to sf for plotting
f <- merge_directed_graph (graph_f)
geoms <- dodgr_to_sfc (f)
gc <- dodgr_contract_graph (f)
gsf <- sf::st_sf (geoms)
gsf$flow <- gc$flow
# sf plot:
library(tmap)
gsf %>% tm_shape() + tm_lines("flow", lwd = "flow", scale = 3)

[mpadge]

Hmmm... submitting as coordinate matrices should work. I'll re-open to fix that

[mpadge]

All works now:

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

graph <- weight_streetnet (hampi, wt_profile = "foot")
v <- dodgr_vertices (graph)
set.seed (1)
n <- 10L
from <- sample (v$id, n)
to <- sample (v$id, n)
flows <- runif (n)
graph_f1 <- dodgr_flows_aggregate (graph, from = from, to = to, flows = flows, pairwise = TRUE)

Then convert to matrix forms:

from <- v [match (from, v$id), c ("x", "y")]
to <- v [match (to, v$id), c ("x", "y")]
graph_f2 <- dodgr_flows_aggregate (graph, from = from, to = to, flows = flows, pairwise = TRUE)

identical (graph_f1, graph_f2)
#> [1] TRUE

^{Created on 2024-06-06 with reprex v2.1.0}