mpadge.tngl.sh
Distances on Directed Graphs in R
1#' Calculate lists of pair-wise shortest paths between points.
2#'
3#' @param graph `data.frame` or equivalent object representing the network
4#' graph (see Details)
5#' @param from Vector or matrix of points **from** which route paths are to
6#' be calculated (see Details)
7#' @param to Vector or matrix of points **to** which route paths are to be
8#' calculated (see Details)
9#' @param vertices If `TRUE`, return lists of lists of vertices for each
10#' path, otherwise return corresponding lists of edge numbers from `graph`.
11#' @param pairwise If `TRUE`, calculate paths only between the ordered
12#' pairs of `from` and `to`. In this case, each of these must be the
13#' same length, and the output will contain paths the i-th members of each, and
14#' thus also be of that length.
15#' @param heap Type of heap to use in priority queue. Options include
16#' Fibonacci Heap (default; `FHeap`), Binary Heap (`BHeap`),
17#' `Radix`, Trinomial Heap (`TriHeap`), Extended Trinomial Heap
18#' (`TriHeapExt`, and 2-3 Heap (`Heap23`).
19#' @param quiet If `FALSE`, display progress messages on screen.
20#' @return List of list of paths tracing all connections between nodes such that
21#' if `x <- dodgr_paths (graph, from, to)`, then the path between
22#' `from[i]` and `to[j]` is `x [[i]] [[j]]`. Each individual path is then a
23#' vector of integers indexing into the rows of `graph` if `vertices = FALSE`,
24#' or into the rows of `dodgr_vertices (graph)` if `vertices = TRUE`.
25#'
26#' @note `graph` must minimally contain four columns of `from`,
27#' `to`, `dist`. If an additional column named `weight` or
28#' `wt` is present, shortest paths are calculated according to values
29#' specified in that column; otherwise according to `dist` values. Either
30#' way, final distances between `from` and `to` points are calculated
31#' according to values of `dist`. That is, paths between any pair of points
32#' will be calculated according to the minimal total sum of `weight`
33#' values (if present), while reported distances will be total sums of
34#' `dist` values.
35#'
36#' The `from` and `to` columns of `graph` may be either single
37#' columns of numeric or character values specifying the numbers or names of
38#' graph vertices, or combinations to two columns specifying geographical
39#' (longitude and latitude) coordinates. In the latter case, almost any sensible
40#' combination of names will be accepted (for example, `fromx, fromy`,
41#' `from_x, from_y`, or `fr_lat, fr_lon`.)
42#'
43#' `from` and `to` values can be either two-column matrices of
44#' equivalent of longitude and latitude coordinates, or else single columns
45#' precisely matching node numbers or names given in `graph$from` or
46#' `graph$to`. If `to` is missing, pairwise distances are calculated
47#' between all points specified in `from`. If neither `from` nor
48#' `to` are specified, pairwise distances are calculated between all nodes
49#' in `graph`.
50#'
51#' @family distances
52#' @export
53#' @examples
54#' graph <- weight_streetnet (hampi)
55#' from <- sample (graph$from_id, size = 100)
56#' to <- sample (graph$to_id, size = 50)
57#' dp <- dodgr_paths (graph, from = from, to = to)
58#' # dp is a list with 100 items, and each of those 100 items has 30 items, each
59#' # of which is a single path listing all vertiex IDs as taken from `graph`.
60#'
61#' # it is also possible to calculate paths between pairwise start and end
62#' # points
63#' from <- sample (graph$from_id, size = 5)
64#' to <- sample (graph$to_id, size = 5)
65#' dp <- dodgr_paths (graph, from = from, to = to, pairwise = TRUE)
66#' # dp is a list of 5 items, each of which just has a single path between each
67#' # pairwise from and to point.
68dodgr_paths <- function (graph,
69 from,
70 to,
71 vertices = TRUE,
72 pairwise = FALSE,
73 heap = "BHeap",
74 quiet = TRUE) {
75
76 hps <- get_heap (heap, graph)
77 heap <- hps$heap
78 graph <- hps$graph
79
80 gr_cols <- dodgr_graph_cols (graph)
81 # cols are (edge_id, from, to, d, w, component, xfr, yfr, xto, yto)
82 vert_map <- make_vert_map (graph, gr_cols)
83
84 if (missing (from)) {
85 from <- vert_map$vert
86 }
87 from_index <- get_path_indices (graph, gr_cols, vert_map, from)
88
89 if (missing (to)) {
90 to <- vert_map$vert
91 }
92 to_index <- get_path_indices (graph, gr_cols, vert_map, to)
93
94 graph <- convert_graph (graph, gr_cols)
95
96 if (!quiet) {
97 message ("Calculating shortest paths ... ", appendLF = FALSE)
98 }
99 if (pairwise) {
100 if (length (from_index$index) != length (to_index$index)) {
101 stop ("pairwise paths require from and to to have same length")
102 }
103 paths <- rcpp_get_paths_pairwise (
104 graph,
105 vert_map,
106 from_index$index,
107 to_index$index,
108 heap
109 )
110 } else {
111 paths <- rcpp_get_paths (
112 graph,
113 vert_map,
114 from_index$index,
115 to_index$index,
116 heap
117 )
118 }
119
120 # convert 1-based indices back into vertex IDs. Note both paths that can not
121 # be traced and single-step paths are returned from the above as NULL. The
122 # former are retained as NULL, while the following converts the latter to
123 # appropriate start-end vertices.
124 paths <- lapply (paths, function (i) {
125 lapply (i, function (j) {
126 if (is.null (j)) {
127 return (j)
128 } # nocov
129 vert_map$vert [j]
130 })
131 }) # nolint
132
133
134 # name path lists
135 if (!is.null (from_index$id) && !is.null (to_index$id)) {
136 if (!pairwise) {
137 for (i in seq_along (from_index$id)) {
138 names (paths [[i]]) <- paste0 (
139 from_index$id [i],
140 "-",
141 to_index$id
142 )
143 }
144 }
145 names (paths) <- from_index$id
146 }
147
148 if (!vertices) {
149 graph_verts <- paste0 ("f", graph$from, "t", graph$to)
150
151 # convert vertex IDs to corresponding sequences of edge numbers
152 paths <- lapply (paths, function (i) {
153 lapply (i, function (j) {
154 if (length (j) > 1) {
155 indx <- 2:length (j)
156 pij <- paste0 (
157 "f", j [indx - 1],
158 "t", j [indx]
159 )
160 res <- match (pij, graph_verts)
161 res <- res [which (!is.na (res))]
162 return (if (length (res) == 0) {
163 NULL
164 } else {
165 res
166 })
167 }
168 })
169 }) # nolint
170 }
171
172 return (paths)
173}
174
175get_path_indices <- function (graph, gr_cols, vert_map, to_from) {
176
177 index_id <- get_index_id_cols (graph, gr_cols, vert_map, to_from)
178
179 index <- index_id$index - 1 # 0-based
180 if (!is.null (index_id$id)) {
181 id <- index_id$id
182 } else {
183 id <- vert_map$vert # nocov
184 }
185
186 return (list (index = index, id = id))
187}