Merge branch 'master' of github.com:ipeaGIT/r5r

.github/workflows/R-CMD-check.yaml

@@ -52,10 +52,12 @@ jobs:
       - uses: r-lib/actions/setup-pandoc@v2
 
       - name: Java setup
-        uses: actions/setup-java@v1
+        uses: actions/setup-java@v2
         with:
+          distribution: 'temurin'
           java-version: '21'
-          java-package: jdk
+          cache: 'gradle'
+
 
       - name: Query dependencies
         run: |

r-package/DESCRIPTION

@@ -32,18 +32,20 @@ Description: Rapid realistic routing on multimodal transport networks
     independent update process. Hence, users should confirm the R5 version
     implied by the Conveyal user manual (see
     <https://docs.conveyal.com/changelog>) corresponds with the R5 version
-    that r5r depends on.
+    that r5r depends on. This version of r5r depends on R5 v7.0.
 License: MIT + file LICENSE
 URL: https://github.com/ipeaGIT/r5r
 BugReports: https://github.com/ipeaGIT/r5r/issues
 Depends:
     R (>= 3.6)
 Imports:
     checkmate,
+    cli,
     concaveman,
     data.table,
     jsonlite,
     rJava (>= 0.9-10),
+    rlang,
     sf (>= 1.0-12),
     sfheaders,
     utils,

r-package/R/onLoad.R

@@ -10,7 +10,7 @@
   }
 
 # package global variables
-r5r_env <- new.env(parent = emptyenv()) # nocov start
+r5r_env <- new.env(parent = emptyenv())
 
 .onLoad <- function(lib, pkg) {
 

r-package/R/r5r_cache.R

@@ -12,11 +12,14 @@
 #' @export
 #' @family Cache data
 #' @examplesIf identical(tolower(Sys.getenv("NOT_CRAN")), "true")
+#' # download r5 JAR
+#' r5r::download_r5()
+#'
 #' # list all files cached
 #' r5r_cache(list_files = TRUE)
 #'
-#' # delete particular file
-#' r5r_cache(delete_file = '2010_deaths')
+#' # delete r5 JAR
+#' r5r_cache(delete_file = 'r5-v7.0')
 #'
 r5r_cache <- function(list_files = TRUE,
                       delete_file = NULL){

r-package/R/setup_r5.R

@@ -144,6 +144,10 @@ setup_r5 <- function(data_path,
     message("\nUsing cached network.dat from ", dat_file)
 
   } else {
+    # check if the user has permission to write to the data directory. if not,
+    # R5 won't be able to create the required files and will fail with a
+    # not-that-enlightening error
+    error_if_no_write_permission(data_path)
 
     # stop r5 in case it is already running
     suppressMessages( r5r::stop_r5() )
@@ -178,3 +182,25 @@ setup_r5 <- function(data_path,
   return(r5r_core)
 
 }
+
+error_if_no_write_permission <- function(data_path) {
+  write_permission <- file.access(data_path, mode = 2)
+
+  normalized_path <- normalizePath(data_path)
+
+  if (write_permission == -1) {
+    cli::cli_abort(
+      c(
+        "Permission to write to {.path {normalized_path}} denied.",
+        i = paste0(
+          "{.pkg r5r} needs write privilege to create the network files. ",
+          "Please make sure you have this privilege in the provided directory."
+        )
+      ),
+      class = "dir_permission_denied",
+      call = rlang::caller_env()
+    )
+  }
+
+  return(invisible(TRUE))
+}

r-package/pkgdown/_pkgdown.yml

@@ -9,32 +9,35 @@ repo:
     source: https://github.com/ipeaGIT/r5r/tree/master/r-package/
 
 reference:
-  - title: "Setup"
+  - title: "Setup network"
   - contents:
-    - download_r5
     - setup_r5
-    - stop_r5
-    - r5r_sitrep
-    - r5r_cache
   - title: "Accessibility"
   - contents:
     - accessibility
   - title: "Routing"
   - contents:
     - travel_time_matrix
     - expanded_travel_time_matrix
-    - pareto_frontier
     - detailed_itineraries
+    - pareto_frontier
   - title: "Isochrone"
   - contents:
     - isochrone
-  - title: "Network"
+  - title: "Extract Network spatial data"
   - contents:
     - street_network_to_sf
     - transit_network_to_sf
-    - find_snap
   - title: "Fare structure"
   - contents:
     - setup_fare_structure
     - read_fare_structure
     - write_fare_structure
+  - title: "Support functions"
+  - contents:
+    - find_snap
+    - r5r_sitrep
+    - r5r_cache
+    - download_r5
+    - stop_r5
+

r-package/tests/testthat/test-setup_r5.R

@@ -63,3 +63,23 @@ test_that("'overwrite' parameter works correctly", {
   )
 
 })
+
+test_that("throws error if write access to given dir is denied", {
+  # this test only works correctly with unix OSes. not sure how to change
+  # permissions from inside R in windows
+  skip_if_not(.Platform$OS.type == "unix")
+
+  invisible(file.copy(path, tempdir(), recursive = TRUE))
+
+  tmpdir <- file.path(tempdir(), "poa")
+
+  data_files <- list.files(tmpdir, full.names = TRUE)
+  files_to_remove <- data_files[grepl("network|\\.pbf\\.mapdb", data_files)]
+  if (length(files_to_remove) > 0) invisible(file.remove(files_to_remove))
+
+  Sys.chmod(tmpdir, "555")
+
+  expect_error(setup_r5(tmpdir), class = "dir_permission_denied")
+
+  Sys.chmod(tmpdir, "755")
+})

r-package/tests/tests_rafa/test-z_r5r_cache.R → r-package/tests/testthat/test-z_r5r_cache.R

@@ -3,7 +3,6 @@ context("r5r_cache")
 # skip tests because they take too much time
 skip_if(Sys.getenv("TEST_ONE") != "")
 testthat::skip_on_cran()
-testthat::skip_if_not_installed("arrow")
 
 try(silent = TRUE, r5r::stop_r5())
 

r-package/vignettes/fare_structure.Rmd

@@ -342,17 +342,21 @@ points <- read.csv(system.file("extdata/poa/poa_hexgrid.csv", package = "r5r"))
 
 # calculate travel times function
 calculate_travel_times <- function(fare) {
-
-  ttm_df <- travel_time_matrix(r5r_core,
-                               origins = points,
-                               destinations = points,
-                               departure_datetime = as.POSIXct("13-05-2019 14:00:00",
-                                                               format = "%d-%m-%Y %H:%M:%S"),
-                               mode = c("WALK", "TRANSIT"),
-                               fare_structure = fare_structure,
-                               max_fare = fare,
-                               max_trip_duration = 40,
-                               max_walk_time = 20)
+  ttm_df <- travel_time_matrix(
+    r5r_core,
+    origins = points,
+    destinations = points,
+    mode = c("WALK", "TRANSIT"),
+    departure_datetime = as.POSIXct(
+      "13-05-2019 14:00:00",
+      format = "%d-%m-%Y %H:%M:%S"
+    ),
+    time_window = 1,
+    fare_structure = fare_structure,
+    max_fare = fare,
+    max_trip_duration = 40,
+    max_walk_time = 20
+  )
 
   return(ttm_df)
 }
@@ -426,24 +430,26 @@ and compare the results the accessibility unconstrained by monetary costs:
 ```{r}
 # calculate accessibility function
 calculate_accessibility <- function(fare, fare_string) {
-
-  access_df <- accessibility(r5r_core,
-                             origins = points,
-                             destinations = points,
-                             departure_datetime = as.POSIXct("13-05-2019 14:00:00",
-                                                             format = "%d-%m-%Y %H:%M:%S"),
-                             opportunities_colname = "healthcare",
-                             mode = c("WALK", "TRANSIT"),
-                             cutoffs = 40,
-                             fare_structure = fare_structure,
-                             max_fare = fare,
-                             max_trip_duration = 40,
-                             max_walk_time = 20,
-                             progress = FALSE)
+  access_df <- accessibility(
+    r5r_core,
+    origins = points,
+    destinations = points,
+    mode = c("WALK", "TRANSIT"),
+    departure_datetime = as.POSIXct(
+      "13-05-2019 14:00:00",
+      format = "%d-%m-%Y %H:%M:%S"
+    ),
+    time_window = 1,
+    opportunities_colname = "healthcare",
+    cutoffs = 40,
+    fare_structure = fare_structure,
+    max_fare = fare,
+    max_trip_duration = 40,
+    max_walk_time = 20,
+    progress = FALSE)
 
   access_df$max_fare <- fare_string
 
-
   return(access_df)
 }