change 'm4ra_cache_dir' to accept 'city' param

to allow city data to exist in sub-directories

Author: mpadge

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: m4ra
 Title: Many-to-Many Multi-Modal Routing Aggregator
-Version: 0.1.1.045
+Version: 0.1.1.046
 Authors@R: 
     person(given = "Mark",
            family = "Padgham",

R/cache.R

@@ -17,9 +17,9 @@ get_hash <- function (graph, contracted = FALSE, force = FALSE) {
     return (hash)
 }
 
-#' Path to user cache directory
+#' Path to user cache directory, optionally for specified city
 #' @noRd
-m4ra_cache_dir <- function () {
+m4ra_cache_dir <- function (city = NULL) {
 
     # use envvar is set, so tempdir can be used on CRAN checks
     cache_dir <- Sys.getenv ("M4RA_CACHE_DIR")
@@ -37,6 +37,18 @@ m4ra_cache_dir <- function () {
         }
     }
 
+    if (!is.null (city)) {
+        checkmate::assert_character (city, len = 1L)
+        flist <- fs::dir_ls (cache_dir, type = "directory", recurse = TRUE)
+        cache_dir <- flist [which (basename (flist) == city)]
+        if (length (cache_dir) == 0L) {
+            cache_dir <- fs::path (Sys.getenv ("M4RA_CACHE_DIR"), city)
+        }
+        if (length (cache_dir) > 1L) {
+            cli::cli_abort ("Ambiguous city directories at {city_dir}.")
+        }
+    }
+
     return (cache_dir)
 }
 
@@ -85,7 +97,7 @@ m4ra_cache_network <- function (graph, city) {
 
     flist_out <- NULL
 
-    cache_dir <- fs::path (m4ra_cache_dir (), city)
+    cache_dir <- m4ra_cache_dir (city)
     city <- gsub ("\\s+", "-", tolower (city))
 
     # Full graph:
@@ -119,7 +131,7 @@ cache_one_graph <- function (graph, city) {
     hash <- substring (a$hash, 1, 6)
     mode <- a$wt_profile
 
-    cache_dir <- fs::path (m4ra_cache_dir (), city)
+    cache_dir <- m4ra_cache_dir (city)
 
     gname <- paste0 (
         "m4ra-", city, "-", mode, "-",
@@ -156,7 +168,7 @@ m4ra_load_cached_network <- function (city = NULL, mode = "foot",
         city <- dirs [length (dirs) - 1L]
         f <- filename
 
-        flist <- fs::dir_ls (fs::path (m4ra_cache_dir (), city), regexp = mode)
+        flist <- fs::dir_ls (m4ra_cache_dir (city), regexp = mode)
 
     } else {
 
@@ -166,11 +178,7 @@ m4ra_load_cached_network <- function (city = NULL, mode = "foot",
 
         mode <- match.arg (tolower (mode), c ("foot", "bicycle", "motorcar"))
 
-        flist <- fs::dir_ls (m4ra_cache_dir (), type = "directory", recurse = TRUE)
-        city_dir <- flist [which (basename (flist) == city)]
-        if (length (city_dir) > 1L) {
-            cli::cli_abort ("Ambiguous city directories at {city_dir}.")
-        }
+        city_dir <- m4ra_cache_dir (city = city)
         flist <- fs::dir_ls (city_dir, regexp = mode)
 
         f <- grep (ptn, flist, value = TRUE)

R/graph-contraction.R

@@ -35,7 +35,7 @@ m4ra_contract_graph <- function (graph, city) {
 
     wt_profile <- attr (graph, "wt_profile")
 
-    cache_dir <- fs::path (m4ra_cache_dir (), city)
+    cache_dir <- m4ra_cache_dir (city)
 
     v <- m4ra_vertices (graph, city)
 

R/parking.R

@@ -49,7 +49,7 @@ m4ra_parking <- function (bb,
 
     v <- m4ra_vertices (graph_c, city_name)
 
-    cache_dir <- fs::path (m4ra_cache_dir (), city_name)
+    cache_dir <- m4ra_cache_dir (city_name)
 
     v_hash <- substring (digest::digest (v$id), 1, 6)
 

R/prepare-data.R

@@ -86,7 +86,7 @@ m4ra_prepare_data <- function (net_sc = NULL,
 
     city_name <- gsub ("\\s+", "-", tolower (city_name))
 
-    cache_dir <- fs::path (m4ra_cache_dir (), city_name)
+    cache_dir <- m4ra_cache_dir (city_name)
 
     if (!is.null (net_sc)) {
         # (Re-)generate weighted networks
@@ -467,7 +467,7 @@ times_gtfs_to_net <- function (files,
 
     f_gtfs_to_net <- grep (
         paste0 (city, "\\-gtfs\\-to\\-net\\-"),
-        fs::dir_ls (fs::path (m4ra_cache_dir (), city)),
+        fs::dir_ls (m4ra_cache_dir (city)),
         value = TRUE
     )
     f_gtfs_to_net <- grep (
@@ -533,7 +533,7 @@ times_gtfs_to_net <- function (files,
         ifelse (fast, "fast", "slow"),
         ".Rds"
     )
-    fname <- fs::path (m4ra_cache_dir (), city, fname)
+    fname <- fs::path (m4ra_cache_dir (city), fname)
 
     if (!fs::file_exists (fname)) {
 

R/times-multi-modal.R

@@ -431,7 +431,7 @@ m4ra_times_mm_car <- function (net_sc = NULL,
 #' @noRd
 add_parking_times <- function (car_times, verts_car, city) {
 
-    cache_dir <- fs::path (m4ra_cache_dir (), city)
+    cache_dir <- m4ra_cache_dir (city)
     f_parking <- fs::dir_ls (cache_dir, regexp = "parking", fixed = TRUE)
 
     if (length (f_parking) > 0) {

R/vertices.R

@@ -21,7 +21,7 @@
 #' v <- m4ra_vertices (graph, "hampi")
 m4ra_vertices <- function (graph, city) {
 
-    cache_dir <- fs::path (m4ra_cache_dir (), city)
+    cache_dir <- m4ra_cache_dir (city)
     if (!fs::dir_exists (cache_dir)) {
         fs::dir_create (cache_dir, recurse = TRUE)
     }

R/weight-networks.R

@@ -40,7 +40,7 @@ cache_networks <- function (net, city, wt_profiles, quiet = TRUE) {
 
     hash <- m4ra_network_hash (net)
 
-    cache_dir <- fs::path (m4ra_cache_dir (), city)
+    cache_dir <- m4ra_cache_dir (city)
     if (!dir.exists (cache_dir)) {
         dir.create (cache_dir, recursive = TRUE)
     }
@@ -107,7 +107,7 @@ cache_networks <- function (net, city, wt_profiles, quiet = TRUE) {
 
 cache_vertex_indices <- function (city) {
 
-    cache_dir <- fs::path (m4ra_cache_dir (), city)
+    cache_dir <- m4ra_cache_dir (city)
 
     # Then cache the indices needed to match vertices between the different
     # networks:
@@ -160,7 +160,7 @@ cache_vertex_indices <- function (city) {
 
 load_vert_index <- function (city, mode1, mode2) {
 
-    cache_dir <- fs::path (m4ra_cache_dir (), city)
+    cache_dir <- m4ra_cache_dir (city)
     flist <- fs::dir_ls (cache_dir, regexp = "\\-vert\\-index\\-")
     f <- grep (paste0 ("\\-", mode1, "\\-", mode2, "\\-"), flist, value = TRUE)
     readRDS (f)

codemeta.json

@@ -7,7 +7,7 @@
   "codeRepository": "https://github.com/UrbanAnalyst/m4ra",
   "issueTracker": "https://github.com/UrbanAnalyst/m4ra/issues",
   "license": "https://spdx.org/licenses/GPL-3.0",
-  "version": "0.1.1.045",
+  "version": "0.1.1.046",
   "programmingLanguage": {
     "@type": "ComputerLanguage",
     "name": "R",