mpadge.tngl.sh
Distances on Directed Graphs in R
1get_hash <- function (graph, verts = NULL, contracted = FALSE, force = FALSE) {
2
3 if (methods::is (graph, "dodgr_contracted")) {
4 hash <- attr (graph, "hashc")
5 if (is.null (hash)) {
6 stop ("Error extracting hash from contracted graph.", call. = FALSE)
7 }
8 return (hash)
9 }
10
11 hash <- NULL
12 if (!force) {
13 hash <- attr (graph, ifelse (contracted, "hashc", "hash"))
14 }
15
16 if (!contracted) {
17 if (is.null (hash)) {
18 gr_cols <- dodgr_graph_cols (graph)
19 hash <- digest::digest (list (graph [[gr_cols$edge_id]], names (graph)))
20 }
21 } else {
22 if (is.null (hash)) {
23 gr_cols <- dodgr_graph_cols (graph)
24 hash <- digest::digest (list (graph [[gr_cols$edge_id]], names (graph), verts))
25 }
26 }
27 return (hash)
28}
29
30get_edge_map <- function (graph) {
31
32 hashc <- get_hash (graph, contracted = TRUE)
33 if (is.null (hashc)) {
34 stop ("something went wrong extracting the edge map")
35 } # nocov
36 fname_c <- fs::path (
37 fs::path_temp (),
38 paste0 ("dodgr_edge_map_", hashc, ".Rds")
39 )
40 if (!fs::file_exists (fname_c)) {
41 stop ("something went wrong extracting the edge map")
42 } # nocov
43 readRDS (fname_c)
44}
45
46#' cache on initial construction with weight_streetnet.
47#'
48#' This pre-calculates and caches the contracted graph *with no additional
49#' intermediate vertices* (that is, the result of `dodgr_contract_graph (graph,
50#' verts = NULL)`). Later calls with explicit additional vertices will generate
51#' different hashes and so will be re-contracted and cached directly in
52#' `dodgr_contract_graph`.
53#'
54#' A copy of the original (full) graph is also copied to a file named with the
55#' hash of the edge map. This is needed for graph uncontraction, so that just the
56#' contracted graph and edge map can be submitted, the original graph re-loaded,
57#' and the uncontracted version returned.
58#' @noRd
59cache_graph <- function (graph, edge_col) {
60
61 td <- fs::path_temp ()
62
63 f <- function (graph, edge_col, td) {
64
65 # the following line does not generate a coverage symbol because it is
66 # cached, so # nocov:
67 verts <- dodgr::dodgr_vertices (graph) # nocov
68 hash <- attr (graph, "hash")
69 fname_v <- fs::path (td, paste0 ("dodgr_verts_", hash, ".Rds"))
70 if (!fs::file_exists (fname_v)) {
71 saveRDS (verts, fname_v)
72 }
73
74 # save original graph to enable subsequent re-loading from the
75 # contracted version
76 fname <- fs::path (td, paste0 ("dodgr_graph_", hash, ".Rds"))
77 saveRDS (graph, fname)
78
79 # The hash for the contracted graph is generated from the edge IDs of
80 # the full graph plus default NULL vertices. Internal functions can not
81 # be called here, so code copied directly from `get_hash`:
82 # hashc <- get_hash (graph, verts = NULL, contracted = TRUE, force = TRUE)
83 hashc <- digest::digest (list (graph [[edge_col]], names (graph), NULL))
84
85 graphc <- dodgr::dodgr_contract_graph (graph)
86 fname_c <- fs::path (td, paste0 ("dodgr_graphc_", hashc, ".Rds"))
87 # graph contraction generally writes that graph already:
88 if (!fs::file_exists (fname_c)) {
89 saveRDS (graphc, fname_c)
90 }
91
92 hashe <- attr (graphc, "hashe")
93 verts <- dodgr::dodgr_vertices (graphc)
94 fname_v <- fs::path (td, paste0 ("dodgr_verts_", hashe, ".Rds"))
95 # But the vertices of the contracted graph are not generally written:
96 if (!fs::file_exists (fname_v)) {
97 saveRDS (verts, fname_v)
98 }
99
100 fname_e <- paste0 ("dodgr_edge_map_", hashc, ".Rds")
101 fname_e_fr <- fs::path (fs::path_temp (), fname_e)
102 fname_e_to <- fs::path (td, fname_e)
103 if (fs::file_exists (fname_e_fr)) { # should always be
104 fs::file_copy (fname_e_fr, fname_e_to, overwrite = TRUE)
105 }
106
107 fname_j <- paste0 ("dodgr_junctions_", hashc, ".Rds")
108 fname_j_fr <- fs::path (fs::path_temp (), fname_j)
109 fname_j_to <- fs::path (td, fname_j)
110 if (fs::file_exists (fname_j_fr)) { # should always be
111 fs::file_copy (fname_j_fr, fname_j_to, overwrite = TRUE)
112 }
113 }
114
115 sink (file = fs::path (fs::path_temp (), "Rout.txt"))
116 res <- callr::r_bg (f, list (graph, edge_col, td))
117 sink ()
118
119 return (res) # R6 processx object
120}
121
122#' Remove cached versions of `dodgr` graphs.
123#'
124#' This function should generally \emph{not} be needed, except if graph
125#' structure has been directly modified other than through `dodgr` functions;
126#' for example by modifying edge weights or distances. Graphs are cached based
127#' on the vector of edge IDs, so manual changes to any other attributes will not
128#' necessarily be translated into changes in `dodgr` output unless the cached
129#' versions are cleared using this function. See
130#' \url{https://github.com/UrbanAnalyst/dodgr/wiki/Caching-of-streetnets-and-contracted-graphs}
131#' for details of caching process.
132#'
133#' @return Nothing; the function silently clears any cached objects
134#' @family cache
135#' @examples
136#' clear_dodgr_cache ()
137#' # Then call dodgr functions as usual:
138#' graph <- weight_streetnet (hampi, wt_profile = "foot")
139#' @export
140clear_dodgr_cache <- function () {
141
142 lf <- list.files (fs::path_temp (), full.names = TRUE, pattern = "^dodgr_")
143 if (length (lf) > 0) {
144 tryCatch (
145 chk <- file.remove (lf),
146 error = function (e) NULL
147 )
148 }
149}
150
151#' Turn off all dodgr caching in current session.
152#'
153#' This function is useful is speed is paramount, and if graph contraction is
154#' not needed. Caching can be switched back on with \link{dodgr_cache_on}.
155#' @return Nothing; the function invisibly returns `TRUE` if successful.
156#' @family cache
157#' @examples
158#' dodgr_cache_off ()
159#' # Then call dodgr functions as usual:
160#' graph <- weight_streetnet (hampi, wt_profile = "foot")
161#' @export
162dodgr_cache_off <- function () {
163 Sys.setenv ("DODGR_CACHE" = "FALSE")
164}
165
166#' Turn on all dodgr caching in current session.
167#'
168#' This will only have an effect after caching has been turned off with
169#' \link{dodgr_cache_off}.
170#' @return Nothing; the function invisibly returns `TRUE` if successful.
171#' @family cache
172#' @examples
173#' dodgr_cache_on ()
174#' # Then call dodgr functions as usual:
175#' graph <- weight_streetnet (hampi, wt_profile = "foot")
176#' @export
177dodgr_cache_on <- function () {
178 Sys.setenv ("DODGR_CACHE" = "TRUE")
179}
180
181
182
183is_dodgr_cache_on <- function () {
184 as.logical (Sys.getenv ("DODGR_CACHE", unset = "TRUE"))
185}