R/save_load_streetnet.R

In dodgr: Distances on Directed Graphs

#' Save a weighted streetnet to a local file
#'
#' The \link{weight_streetnet} function returns a single `data.frame` object,
#' the processing of which also relies on a couple of cached lookup-tables to
#' match edges in the `data.frame` to objects in the original input data. It
#' automatically calculates and caches a contracted version of the same graph,
#' to enable rapid conversion between contracted and uncontracted forms. This
#' function saves all of these items in a single `.Rds` file, so that a the
#' result of a link{weight_streetnet} call can be rapidly loaded into a
#' workspace in subsequent sessions, rather than re-calculating the entire
#' weighted network.
#'
#' @note This may take some time if \link{dodgr_cache_off} has been called.
#' The contracted version of the graph is also saved, and so must be calculated
#' if it has not previously been automatically cached.
#'
#' @param net `data.frame` or equivalent object representing the weighted
#' network graph.
#' @param filename Name with optional full path of file in which to save the
#' input `net`. The extension `.Rds` will be automatically appended, unless
#' specified otherwise.
#'
#' @examples
#' net <- weight_streetnet (hampi)
#' f <- file.path (tempdir (), "streetnet.Rds")
#' dodgr_save_streetnet (net, f)
#' clear_dodgr_cache () # rm cached objects from tempdir
#' # at some later time, or in a new R session:
#' net <- dodgr_load_streetnet (f)
#' @family cache
#' @export
dodgr_save_streetnet <- function (net, filename = NULL) {

    if (is.null (filename)) {
        stop ("'filename' must be specified.")
    }
    if (!is.character (filename)) {
        stop ("'filename' must be specified as character value.")
    }
    if (length (filename) != 1L) {
        stop ("'filename' must be specified as single character value.")
    }

    if (tools::file_ext (filename) == "") {
        filename <- paste0 (filename, ".Rds")
    }

    # This function is essentially cache_graph in reverse
    hash <- attr (net, "hash")
    td <- fs::path_temp ()

    fname_v <- fs::path (td, paste0 ("dodgr_verts_", hash, ".Rds"))
    if (fs::file_exists (fname_v)) {
        v <- readRDS (fname_v)
    } else {
        v <- dodgr_vertices (net)
    }

    # The hash for the contracted graph is generated from the edge IDs of
    # the full graph plus default NULL vertices:
    gr_cols <- dodgr_graph_cols (net)
    edge_col <- gr_cols$edge_id
    hashc <- get_hash (net, contracted = TRUE, verts = NULL, force = TRUE)

    fname_c <- fs::path (td, paste0 ("dodgr_graphc_", hashc, ".Rds"))
    if (fs::file_exists (fname_c)) {
        graphc <- readRDS (fname_c)
    } else {
        graphc <- dodgr::dodgr_contract_graph (net)
    }

    hashe <- attr (graphc, "hashe")
    fname_vc <- fs::path (td, paste0 ("dodgr_verts_", hashe, ".Rds"))
    if (fs::file_exists (fname_vc)) {
        verts_c <- readRDS (fname_vc)
    } else {
        verts_c <- dodgr::dodgr_vertices (graphc)
    }

    fname_e <- fs::path (td, paste0 ("dodgr_edge_map_", hashc, ".Rds"))
    if (!fs::file_exists (fname_e)) { # should always be
        stop ("edge_map was not cached; unable to save network.")
    }

    edge_map <- readRDS (fname_e)

    fname_j <- fs::path (td, paste0 ("dodgr_junctions_", hashc, ".Rds"))
    if (!fs::file_exists (fname_j)) { # should always be
        stop ("junction list was not cached; unable to save network.")
    }
    junctions <- readRDS (fname_j)

    out <- list (
        graph = net,
        verts = v,
        graph_c = graphc,
        verts_c = verts_c,
        edge_map = edge_map,
        junctions = junctions
    )

    saveRDS (out, filename)
}

#' Load a street network previously saved with \link{dodgr_save_streetnet}.
#'
#' This always returns the full, non-contracted graph. The contracted graph can
#' be generated by passing the result to \link{dodgr_contract_graph}.
#' @param filename Name (with optional full path) of file to be loaded.
#'
#' @examples
#' net <- weight_streetnet (hampi)
#' f <- file.path (tempdir (), "streetnet.Rds")
#' dodgr_save_streetnet (net, f)
#' clear_dodgr_cache () # rm cached objects from tempdir
#' # at some later time, or in a new R session:
#' net <- dodgr_load_streetnet (f)
#' @family cache
#' @export
dodgr_load_streetnet <- function (filename) {

    if (!fs::file_exists (filename)) {
        stop ("filename [", filename, "] not found.")
    }

    td <- fs::path_temp ()
    x <- readRDS (filename)

    hash <- attr (x$graph, "hash")
    hashc <- attr (x$graph_c, "hashc") # hash for contracted graph
    hashe <- attr (x$graph_c, "hashe") # hash for edge map

    fname <- fs::path (td, paste0 ("dodgr_graph_", hash, ".Rds"))
    if (!fs::file_exists (fname)) {
        saveRDS (x$graph, fname)
    }

    fname_v <- fs::path (td, paste0 ("dodgr_verts_", hash, ".Rds"))
    if (!fs::file_exists (fname_v)) {
        saveRDS (x$verts, fname_v)
    }

    fname_c <- fs::path (td, paste0 ("dodgr_graphc_", hashc, ".Rds"))
    if (!fs::file_exists (fname_c)) {
        saveRDS (x$graph_c, fname_c)
    }

    fname_vc <- fs::path (td, paste0 ("dodgr_verts_", hashe, ".Rds"))
    if (!fs::file_exists (fname_vc)) {
        saveRDS (x$verts_c, fname_vc)
    }

    fname_e <- fs::path (td, paste0 ("dodgr_edge_map_", hashc, ".Rds"))
    if (!fs::file_exists (fname_e)) {
        saveRDS (x$edge_map, fname_e)
    }

    fname_j <- fs::path (td, paste0 ("dodgr_junctions_", hashc, ".Rds"))
    if (!fs::file_exists (fname_j)) {
        saveRDS (x$junctions, fname_j)
    }

    return (x$graph)
}