mpadge.tngl.sh
Distances on Directed Graphs in R
1null_to_na <- function (x) {
2
3 if (length (x) == 0) {
4 x <- NA
5 }
6 return (x)
7}
8
9#' Match the heap arg and convert graph is necessary
10#'
11#' @param heap Name of heap as passed to `dodgr_dists`
12#' @param graph `data.frame` of graph edges
13#' @return List of matched heap arg and potentially converted graph
14#' @noRd
15get_heap <- function (heap,
16 graph) {
17
18 heaps <- c ("FHeap", "BHeap", "TriHeap", "TriHeapExt", "Heap23", "set")
19 heap <- match.arg (arg = heap, choices = heaps)
20
21 list (heap = heap, graph = graph)
22}
23
24#' Get appropriate measure for geodist distances.
25#'
26#' Default measure is "cheap", but that becomes inaccurate beyond around 100km.
27#' This function works out the approximate maximal graph distances, and
28#' determines an appropriate measure based on that. Note that "geodesic"
29#' distances are not used, as calculation times for those are enormously longer
30#' than either cheap or Haversine.
31#'
32#' Measures for graphs are stored in `options("dodgr_dist_measure")`, as a list
33#' with each measure named after the graph hash.
34#'
35#' @return "cheap" if maximal distances are < 100km, otherwise "haversine".
36#' @noRd
37get_geodist_measure <- function (graph) {
38
39 hash <- attr (graph, "hash")
40 measure_list <- getOption ("dodgr_dist_measure", "")
41
42 has_measure <- !is.null (hash)
43 has_single_measure <- FALSE
44 if ("all" %in% names (measure_list)) {
45 has_single_measure <- TRUE
46 } else if (has_measure) {
47 has_measure <- any (nzchar (measure_list)) && hash %in% names (measure_list)
48 }
49
50 if (has_single_measure) {
51 measure <- measure_list [["all"]]
52 } else if (has_measure) {
53 measure <- measure_list [[hash]]
54 } else {
55 dmax <- max_spatial_dist (graph) / 1000
56 measure <- ifelse (dmax < 100, "cheap", "haversine")
57
58 # This is also called at the start of SC construction, before graph has
59 # any hash.
60 if (!is.null (hash)) {
61 if (!any (nzchar (measure_list))) {
62 measure_list <- NULL
63 }
64 measure_list <- c (measure_list, measure)
65 names (measure_list) [length (measure_list)] <- eval (hash)
66 options ("dodgr_dist_measure" = measure_list)
67 }
68 }
69
70 return (measure)
71}
72
73#' Force \link{weight_streetnet} to use geodesic distances.
74#'
75#' Distances by default are Mapbox "cheap" distances if maximal network
76#' distances are < 100km, otherwise Haversine distances. Calling this function
77#' forces all calls to \link{weight_streetnet} from that point on to use
78#' geodesic distances. These are more computationally expensive to calculate,
79#' and weighting networks will likely take more time.
80#'
81#' @param unset Calling this function with `unset = TRUE` reverts distance
82#' calculations to those described above, rather than geodesic.
83#' @return Nothing; the function is called for its side-effect only of setting
84#' distance calculations to geodesic.
85#'
86#' @family extraction
87#' @examples
88#' net0 <- weight_streetnet (hampi) # Default "cheap" method
89#' dodgr_streetnet_geodesic ()
90#' net1 <- weight_streetnet (hampi)
91#' cor (net0$d, net1$d) # Strongly correlated, but not perfect
92#' max (abs (net0$d - net1$d)) # in metres
93#' @export
94dodgr_streetnet_geodesic <- function (unset = FALSE) {
95
96 if (unset) {
97 options ("dodgr_dist_measure" = NULL)
98 msg <- "revert to default measures"
99 } else {
100 options ("dodgr_dist_measure" = c (all = "geodesic"))
101 msg <- "use the geodesic measure"
102 }
103
104 objs <- ls (envir = .GlobalEnv)
105 objs_are_graphs <- vapply (objs, function (o) {
106 inherits (get (o), "dodgr_streetnet")
107 }, logical (1L))
108 if (any (objs_are_graphs)) {
109 message (
110 "Only graphs created from this point on with ",
111 "'weight_streetnet()' will ",
112 msg
113 )
114 }
115}