From 035487cb86b92b8457f2c686ee90e1b6350c7b68 Mon Sep 17 00:00:00 2001 From: Egor Kotov Date: Thu, 4 Jan 2024 17:29:21 +0100 Subject: [PATCH 1/3] experimental support for OTP v2.2+ isochrones --- R/otp-isochrone-batch.R | 58 +++++++++++++++++++++++++++++++++-------- 1 file changed, 47 insertions(+), 11 deletions(-) diff --git a/R/otp-isochrone-batch.R b/R/otp-isochrone-batch.R index 863d8e5..9b065f4 100644 --- a/R/otp-isochrone-batch.R +++ b/R/otp-isochrone-batch.R @@ -52,8 +52,10 @@ otp_isochrone <- function(otpcon = NA, timezone = otpcon$timezone) { # Check for OTP2 if (!is.null(otpcon$otp_version)) { - if (otpcon$otp_version >= 2) { - stop("Isochrones are not supported by OTP v2.X") + if (otpcon$otp_version >= 2.0 & otpcon$otp_version <= 2.1) { + stop("Isochrones are not supported by OTP v2.0-2.1. Consider using v1.5 or v2.2+.") + } else if (otpcon$otp_version >= 2.2) { + message("OTP v2.2+ experimentaly supports isochrones, see https://docs.opentripplanner.org/en/v2.4.0/sandbox/TravelTime/") } } @@ -99,15 +101,38 @@ otp_isochrone <- function(otpcon = NA, # } routerUrl <- make_url(otpcon) - routerUrl <- paste0(routerUrl, "/isochrone") - - query <- list( - mode = mode, - date = date, - time = time, - maxWalkDistance = maxWalkDistance, - arriveBy = arriveBy - ) + if (otpcon$otp_version <= 1.9) { + routerUrl <- paste0(routerUrl, "/isochrone") + } else if (otpcon$otp_version >= 2.2) { + routerUrl <- paste0(sub("/otp.*", "/", routerUrl), "otp/traveltime/isochrone") + } + + if (otpcon$otp_version <= 1.9) { + query <- list( + mode = mode, + date = date, + time = time, + maxWalkDistance = maxWalkDistance, + arriveBy = arriveBy + ) + } else if (otpcon$otp_version >= 2.2) { + format_ISO8601 <- function(date) { + # Format date and time + formatted <- format(date, "%Y-%m-%dT%H:%M:%S") + + # Format timezone and insert colon + tz_formatted <- format(date, "%z") + tz_with_colon <- paste0(substr(tz_formatted, 1, 3), ":", substr(tz_formatted, 4, 5)) + + # Combine date and modified timezone + paste0(formatted, tz_with_colon) + } + query <- list( + mode = mode, + time = format_ISO8601(date_time), + arriveBy = arriveBy + ) + } cutoffSec <- as.list(cutoffSec) names(cutoffSec) <- rep("cutoffSec", length(cutoffSec)) query <- c(query, cutoffSec) @@ -118,8 +143,19 @@ otp_isochrone <- function(otpcon = NA, # Send Requests urls <- build_urls(routerUrl,fromPlace, toPlace = NULL, query) + if (otpcon$otp_version >= 2.2) { + urls <- gsub("fromPlace", "location", urls) + } message(Sys.time()," sending ",length(urls)," isochrone requests using ",ncores," threads") progressr::handlers("cli") + if (otpcon$otp_version >= 2.2) { + urls <- paste0( + sub("(https?://[^?]+\\?)(.*)", "\\1", urls), + gsub("\\+", "%2B", + gsub(":", "%3A", + sub("(https?://[^?]+\\?)(.*)", "\\2", urls)))) + + } results <- progressr::with_progress(otp_async(urls, ncores, TRUE)) if (is.null(fromID)) { From 31b5711e3751d2e365e7d5490e632bc2af373a4c Mon Sep 17 00:00:00 2001 From: Egor Kotov Date: Fri, 5 Jan 2024 13:39:05 +0100 Subject: [PATCH 2/3] simplify request url generation for OTPv2, fix related bugs, add warning about limitations of v2 isochrone API --- R/otp-isochrone-batch.R | 37 +++++++++++++++++-------------------- 1 file changed, 17 insertions(+), 20 deletions(-) diff --git a/R/otp-isochrone-batch.R b/R/otp-isochrone-batch.R index 9b065f4..49060f5 100644 --- a/R/otp-isochrone-batch.R +++ b/R/otp-isochrone-batch.R @@ -59,6 +59,13 @@ otp_isochrone <- function(otpcon = NA, } } + # Warn about walking isochrones not being supported by OTP v2 + if (otpcon$otp_version >= 2.0) { + if (length(mode) == 1 && mode == "WALK") { + warning("Walking-only isochrones are not supported by OTP v2. You can only use \"WALK,TRANSIT\". When set to \"WALK\" OTPv2 defaults to \"WALK,TRANSIT\". See https://docs.opentripplanner.org/en/v2.4.0/sandbox/TravelTime/") + } + } + # Check Valid Inputs checkmate::assert_numeric(ncores, lower = 1, len = 1, upper = max(c(round(parallel::detectCores() * 1.25 ) - 1,2))) checkmate::assert_class(otpcon, "otpconnect") @@ -115,27 +122,20 @@ otp_isochrone <- function(otpcon = NA, maxWalkDistance = maxWalkDistance, arriveBy = arriveBy ) + cutoffSec <- as.list(cutoffSec) + names(cutoffSec) <- rep("cutoffSec", length(cutoffSec)) + query <- c(query, cutoffSec) } else if (otpcon$otp_version >= 2.2) { - format_ISO8601 <- function(date) { - # Format date and time - formatted <- format(date, "%Y-%m-%dT%H:%M:%S") - - # Format timezone and insert colon - tz_formatted <- format(date, "%z") - tz_with_colon <- paste0(substr(tz_formatted, 1, 3), ":", substr(tz_formatted, 4, 5)) - - # Combine date and modified timezone - paste0(formatted, tz_with_colon) - } query <- list( mode = mode, - time = format_ISO8601(date_time), + time = sub("(.*\\+)(\\d{2})(\\d{2})", "\\1\\2:\\3", strftime(date_time, format = "%Y-%m-%dT%H:%M:%S%z")), arriveBy = arriveBy ) + cutoff <- as.list(paste0("PT", cutoffSec, "S")) + names(cutoff) <- rep("cutoff", length(cutoff)) + query <- c(query, cutoff) } - cutoffSec <- as.list(cutoffSec) - names(cutoffSec) <- rep("cutoffSec", length(cutoffSec)) - query <- c(query, cutoffSec) + if (!is.null(routingOptions)) { query <- c(query, routingOptions) @@ -145,17 +145,14 @@ otp_isochrone <- function(otpcon = NA, urls <- build_urls(routerUrl,fromPlace, toPlace = NULL, query) if (otpcon$otp_version >= 2.2) { urls <- gsub("fromPlace", "location", urls) - } - message(Sys.time()," sending ",length(urls)," isochrone requests using ",ncores," threads") - progressr::handlers("cli") - if (otpcon$otp_version >= 2.2) { urls <- paste0( sub("(https?://[^?]+\\?)(.*)", "\\1", urls), gsub("\\+", "%2B", gsub(":", "%3A", sub("(https?://[^?]+\\?)(.*)", "\\2", urls)))) - } + message(Sys.time()," sending ",length(urls)," isochrone requests using ",ncores," threads") + progressr::handlers("cli") results <- progressr::with_progress(otp_async(urls, ncores, TRUE)) if (is.null(fromID)) { From 53e53e8b093a7cdde2a49cf8e054c6d895514529 Mon Sep 17 00:00:00 2001 From: Egor Kotov Date: Fri, 5 Jan 2024 13:40:14 +0100 Subject: [PATCH 3/3] fix line that prevents using filename of OTP jar to easily download form github releases because the version part of the filename may not not be the same (e.g. not contain v) as the rest of the url --- R/otp-download.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/otp-download.R b/R/otp-download.R index 59eaac9..4ca010e 100644 --- a/R/otp-download.R +++ b/R/otp-download.R @@ -52,7 +52,7 @@ otp_dl_jar <- function(path = NULL, warning("OTP2 support is in beta \n") } - url <- paste0(url, "/", version, "/otp-", version, "-shaded.jar") + url <- paste0(url, "/", version, "/", file_name) message("The OTP will be saved to ", destfile) utils::download.file(url = url, destfile = destfile, mode = "wb", quiet = quiet)