R/utils.R

In dodgr: Distances on Directed Graphs

null_to_na <- function (x) {

    if (length (x) == 0) {
        x <- NA
    }
    return (x)
}

#' Match the heap arg and convert graph is necessary
#'
#' @param heap Name of heap as passed to `dodgr_dists`
#' @param graph `data.frame` of graph edges
#' @return List of matched heap arg and potentially converted graph
#' @noRd
get_heap <- function (heap,
                      graph) {

    heaps <- c ("FHeap", "BHeap", "TriHeap", "TriHeapExt", "Heap23", "set")
    heap <- match.arg (arg = heap, choices = heaps)

    list (heap = heap, graph = graph)
}

#' Get appropriate measure for geodist distances.
#'
#' Default measure is "cheap", but that becomes inaccurate beyond around 100km.
#' This function works out the approximate maximal graph distances, and
#' determines an appropriate measure based on that. Note that "geodesic"
#' distances are not used, as calculation times for those are enormously longer
#' than either cheap or Haversine.
#'
#' Measures for graphs are stored in `options("dodgr_dist_measure")`, as a list
#' with each measure named after the graph hash.
#'
#' @return "cheap" if maximal distances are < 100km, otherwise "haversine".
#' @noRd
get_geodist_measure <- function (graph) {

    hash <- attr (graph, "hash")
    measure_list <- getOption ("dodgr_dist_measure", "")

    has_measure <- !is.null (hash)
    has_single_measure <- FALSE
    if ("all" %in% names (measure_list)) {
        has_single_measure <- TRUE
    } else if (has_measure) {
        has_measure <- any (nzchar (measure_list)) && hash %in% names (measure_list)
    }

    if (has_single_measure) {
        measure <- measure_list [["all"]]
    } else if (has_measure) {
        measure <- measure_list [[hash]]
    } else {
        dmax <- max_spatial_dist (graph) / 1000
        measure <- ifelse (dmax < 100, "cheap", "haversine")

        # This is also called at the start of SC construction, before graph has
        # any hash.
        if (!is.null (hash)) {
            if (!any (nzchar (measure_list))) {
                measure_list <- NULL
            }
            measure_list <- c (measure_list, measure)
            names (measure_list) [length (measure_list)] <- eval (hash)
            options ("dodgr_dist_measure" = measure_list)
        }
    }

    return (measure)
}

#' Force \link{weight_streetnet} to use geodesic distances.
#'
#' Distances by default are Mapbox "cheap" distances if maximal network
#' distances are < 100km, otherwise Haversine distances. Calling this function
#' forces all calls to \link{weight_streetnet} from that point on to use
#' geodesic distances. These are more computationally expensive to calculate,
#' and weighting networks will likely take more time.
#'
#' @param unset Calling this function with `unset = TRUE` reverts distance
#' calculations to those described above, rather than geodesic.
#' @return Nothing; the function is called for its side-effect only of setting
#' distance calculations to geodesic.
#'
#' @family extraction
#' @examples
#' net0 <- weight_streetnet (hampi) # Default "cheap" method
#' dodgr_streetnet_geodesic ()
#' net1 <- weight_streetnet (hampi)
#' cor (net0$d, net1$d) # Strongly correlated, but not perfect
#' max (abs (net0$d - net1$d)) # in metres
#' @export
dodgr_streetnet_geodesic <- function (unset = FALSE) {

    if (unset) {
        options ("dodgr_dist_measure" = NULL)
        msg <- "revert to default measures"
    } else {
        options ("dodgr_dist_measure" = c (all = "geodesic"))
        msg <- "use the geodesic measure"
    }

    objs <- ls (envir = .GlobalEnv)
    objs_are_graphs <- vapply (objs, function (o) {
        inherits (get (o), "dodgr_streetnet")
    }, logical (1L))
    if (any (objs_are_graphs)) {
        message (
            "Only graphs created from this point on with ",
            "'weight_streetnet()' will ",
            msg
        )
    }
}