Merge pull request #126 from munterfinger/release/v0.7.0

Release/v0.7.0

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: hereR
 Type: Package
 Title: 'sf'-Based Interface to the 'HERE' REST APIs
-Version: 0.6.1
+Version: 0.7.0
 Authors@R: c(
     person("Merlin", "Unterfinger", role = c("aut", "cre"), email = "[email protected]", comment = c(ORCID = "0000-0003-2020-2366")),
     person("Daniel", "Possenriede", role = "ctb", comment = c(ORCID = "0000-0002-6738-9845")))
@@ -19,8 +19,9 @@ Description: Interface to the 'HERE' REST APIs <https://developer.here.com/devel
   Locations, routes and isolines are returned as 'sf' objects.
 Depends: R (>= 3.3.0)
 Imports: 
+    crul (>= 1.1.0),
     curl (>= 4.3),
-    data.table (>= 1.12.6),
+    data.table (>= 1.13.0),
     flexpolyline (>= 0.2.0),
     jsonlite (>= 1.7.0),
     sf (>= 0.9-0),

NAMESPACE

@@ -14,6 +14,7 @@ export(route_matrix)
 export(set_auth)
 export(set_key)
 export(set_proxy)
+export(set_rate_limit)
 export(set_verbose)
 export(station)
 export(traffic)

NEWS.md

@@ -1,3 +1,13 @@
+# version 0.7.0
+
+* Enable `optimize` parameter to chose from "balanced", "quality" and "performance" in `isoline()` (closes [#119](https://github.com/munterfinger/hereR/issues/119)).
+* Remove deprecated parameters in `route()`, `route_matrix()` and `isoline()`.
+* Add specific user-agent to the requests: `hereR/<version> R/<version> (<platform>)`.
+* Add option to deactivate rate limits `set_rate_limit(FALSE)`.
+* Bugfix: Add rate limits in RPS (requests per seconds) to async requests to the APIs; move dependency for requests from **curl** to **crul** package (closes [#122](https://github.com/munterfinger/hereR/issues/122)).
+* Bugfix: `isoline()` now handles multipart polygons (MULTIPOLYGON) if received by the API (closes [#121](https://github.com/munterfinger/hereR/issues/121)).
+* Add area and feature avoidance in `route()` (closes [#117](https://github.com/munterfinger/hereR/issues/117)).
+
 # version 0.6.1
 
 * Use **styler** package and use `tyler::tidyverse_style()`to format the package.

R/autosuggest.R

@@ -21,7 +21,7 @@
 autosuggest <- function(address, results = 5, url_only = FALSE) {
 
   # Check addresses
-  .check_addresses(address)
+  .check_character(address)
   .check_numeric_range(results, 1, 100)
   .check_boolean(url_only)
 
@@ -34,7 +34,7 @@ autosuggest <- function(address, results = 5, url_only = FALSE) {
   url <- paste0(
     url,
     "&q=",
-    address
+    curl::curl_escape(address)
   )
 
   # Add bbox containing the world
@@ -56,8 +56,9 @@ autosuggest <- function(address, results = 5, url_only = FALSE) {
   }
 
   # Request and get content
-  data <- .get_content(
-    url = url
+  data <- .async_request(
+    url = url,
+    rps = 5
   )
   if (length(data) == 0) {
     return(NULL)

R/checks.R

@@ -1,20 +1,20 @@
-.check_addresses <- function(addresses) {
-  if (!is.character(addresses)) {
+.check_character <- function(text) {
+  if (!is.character(text) & !is.null(text)) {
     stop(sprintf(
       "'%s' must be a 'character' vector.",
-      deparse(substitute(addresses))
+      deparse(substitute(text))
     ))
   }
-  if (any(is.na(addresses))) {
+  if (any(is.na(text))) {
     stop(sprintf(
       "'%s' contains NAs.",
-      deparse(substitute(addresses))
+      deparse(substitute(text))
     ))
   }
-  if ("" %in% gsub(" ", "", addresses)) {
+  if ("" %in% gsub(" ", "", text)) {
     stop(sprintf(
       "'%s' contains empty strings.",
-      deparse(substitute(addresses))
+      deparse(substitute(text))
     ))
   }
 }
@@ -41,26 +41,28 @@
 }
 
 .check_polygon <- function(polygon) {
-  if (!"sf" %in% class(polygon)) {
-    stop(sprintf(
-      "'%s' must be an sf object.",
-      deparse(substitute(polygon))
-    ))
-  }
-  if (any(sf::st_is_empty(polygon))) {
-    stop(sprintf(
-      "'%s' has empty entries in the geometry column.",
-      deparse(substitute(polygon))
-    ))
-  }
-  if (!"sf" %in% class(polygon) |
-    any(!(
-      sf::st_geometry_type(polygon) %in% c("POLYGON", "MULTIPOLYGON")
-    ))) {
-    stop(sprintf(
-      "'%s' must be an sf object with geometry type 'POLYGON' or 'MULTIPOLYGON'.",
-      deparse(substitute(polygon))
-    ))
+  if (!is.null(polygon)) {
+    if (!"sf" %in% class(polygon)) {
+      stop(sprintf(
+        "'%s' must be an sf object.",
+        deparse(substitute(polygon))
+      ))
+    }
+    if (any(sf::st_is_empty(polygon))) {
+      stop(sprintf(
+        "'%s' has empty entries in the geometry column.",
+        deparse(substitute(polygon))
+      ))
+    }
+    if (!"sf" %in% class(polygon) |
+      any(!(
+        sf::st_geometry_type(polygon) %in% c("POLYGON", "MULTIPOLYGON")
+      ))) {
+      stop(sprintf(
+        "'%s' must be an sf object with geometry type 'POLYGON' or 'MULTIPOLYGON'.",
+        deparse(substitute(polygon))
+      ))
+    }
   }
 }
 
@@ -140,6 +142,19 @@
   }
 }
 
+.check_optimize <- function(optimize) {
+  optimizations <- c("balanced", "quality", "performance")
+  if (!optimize %in% optimizations) {
+    stop(
+      sprintf(
+        "Optimization method '%s' not valid, must be in ('%s').",
+        optimize,
+        paste(optimizations, collapse = "', '")
+      )
+    )
+  }
+}
+
 .check_range_type <- function(range_type) {
   range_types <- c("distance", "time", "consumption")
   if (!range_type %in% range_types) {
@@ -198,3 +213,18 @@
     ))
   }
 }
+
+.check_internet <- function() {
+  access <- tryCatch(
+    {
+      curl::has_internet()
+    },
+    error = function(cond) {
+      warning(cond)
+      return(FALSE)
+    }
+  )
+  if (!access) {
+    stop("Connection error: Please check internet access and proxy configuration.")
+  }
+}

R/connection.R

@@ -115,8 +115,9 @@ connection <- function(origin, destination, datetime = Sys.time(),
   }
 
   # Request and get content
-  data <- .get_content(
-    url = url
+  data <- .async_request(
+    url = url,
+    rps = 10
   )
   if (length(data) == 0) {
     return(NULL)

R/flow.R

@@ -86,8 +86,9 @@ flow <- function(aoi, min_jam_factor = 0, url_only = FALSE) {
   }
 
   # Request and get content
-  data <- .get_content(
-    url = url
+  data <- .async_request(
+    url = url,
+    rps = Inf
   )
   if (length(data) == 0) {
     return(NULL)

R/geocode.R

@@ -36,7 +36,7 @@
 geocode <- function(address, alternatives = FALSE, sf = TRUE, url_only = FALSE) {
 
   # Input checks
-  .check_addresses(address)
+  .check_character(address)
   .check_boolean(alternatives)
   .check_boolean(sf)
   .check_boolean(url_only)
@@ -50,7 +50,7 @@ geocode <- function(address, alternatives = FALSE, sf = TRUE, url_only = FALSE)
   url <- paste0(
     url,
     "&q=",
-    gsub("\\|", "", address)
+    curl::curl_escape(address)
   )
 
   # Return urls if chosen
@@ -59,8 +59,9 @@ geocode <- function(address, alternatives = FALSE, sf = TRUE, url_only = FALSE)
   }
 
   # Request and get content
-  data <- .get_content(
-    url = url
+  data <- .async_request(
+    url = url,
+    rps = 5
   )
   if (length(data) == 0) {
     return(NULL)

R/incident.R

@@ -70,8 +70,9 @@ incident <- function(aoi, from = Sys.time() - 60 * 60 * 24 * 7, url_only = FALSE
   }
 
   # Request and get content
-  data <- .get_content(
-    url = url
+  data <- .async_request(
+    url = url,
+    rps = Inf
   )
   if (length(data) == 0) {
     return(NULL)

R/intermodal_route.R

@@ -101,8 +101,9 @@ intermodal_route <- function(origin, destination, datetime = Sys.time(),
   }
 
   # Request and get content
-  data <- .get_content(
-    url = url
+  data <- .async_request(
+    url = url,
+    rps = 5
   )
   if (length(data) == 0) {
     return(NULL)

R/isoline.R

@@ -15,11 +15,10 @@
 #' @param routing_mode character, set the routing mode: \code{"fast"} or \code{"short"}.
 #' @param transport_mode character, set the transport mode: \code{"car"}, \code{"pedestrian"} or \code{"truck"}.
 #' @param traffic boolean, use real-time traffic or prediction in routing (\code{default = TRUE})? If no traffic is selected, the \code{datetime} is set to \code{"any"} and the request is processed independently from time.
+#' @param optimize, character, specifies how isoline calculation is optimized: \code{"balanced"}, \code{"quality"} or \code{"performance"} (\code{default = "balanced"}).
 #' @param consumption_model character, specify the consumption model of the vehicle, see \href{https://developer.here.com/documentation/routing-api/8.16.0/dev_guide/topics/use-cases/consumption-model.html}{consumption model} for more information (\code{default = NULL} a average electric car is set).
 #' @param aggregate boolean, aggregate (with function \code{min}) and intersect the isolines from geometry type \code{POLYGON} to geometry type \code{MULTIPOLYGON} (\code{default = TRUE})?
 #' @param url_only boolean, only return the generated URLs (\code{default = FALSE})?
-#' @param type character, 'type' is deprecated, use 'routing_mode' instead.
-#' @param mode character, 'mode' is deprecated, use 'transport_mode' instead.
 #'
 #' @return
 #' An \code{sf} object containing the requested isolines.
@@ -38,25 +37,17 @@
 isoline <- function(poi, datetime = Sys.time(), arrival = FALSE,
                     range = seq(5, 30, 5) * 60, range_type = "time",
                     routing_mode = "fast", transport_mode = "car",
-                    traffic = TRUE, consumption_model = NULL,
-                    aggregate = TRUE, url_only = FALSE, type, mode) {
-
-  # Deprecated parameters
-  if (!missing("type")) {
-    warning("'type' is deprecated, use 'routing_mode' instead.")
-    routing_mode <- type
-  }
-  if (!missing("mode")) {
-    warning("'mode' is deprecated, use 'transport_mode' instead.")
-    transport_mode <- mode
-  }
+                    traffic = TRUE, optimize = "balanced",
+                    consumption_model = NULL, aggregate = TRUE,
+                    url_only = FALSE) {
 
   # Checks
   .check_points(poi)
   .check_datetime(datetime)
   .check_range_type(range_type)
   .check_routing_mode(routing_mode)
   .check_transport_mode(transport_mode, request = "isoline")
+  .check_optimize(optimize)
   .check_boolean(traffic)
   .check_boolean(arrival)
   .check_boolean(aggregate)
@@ -111,6 +102,13 @@ isoline <- function(poi, datetime = Sys.time(), arrival = FALSE,
     range_type
   )
 
+  # Add optimization method
+  url <- paste0(
+    url,
+    "&optimizeFor=",
+    optimize
+  )
+
   # Add consumption model if specified, otherwise set to default electric vehicle
   if (is.null(consumption_model)) {
     url <- paste0(
@@ -141,8 +139,9 @@ isoline <- function(poi, datetime = Sys.time(), arrival = FALSE,
   }
 
   # Request and get content
-  data <- .get_content(
-    url = url
+  data <- .async_request(
+    url = url,
+    rps = 1
   )
   if (length(data) == 0) {
     return(NULL)
@@ -180,8 +179,7 @@ isoline <- function(poi, datetime = Sys.time(), arrival = FALSE,
   isolines <- sf::st_as_sf(
     isolines,
     sf_column_name = "geometry",
-    crs = 4326,
-    check_ring_dir = TRUE
+    crs = 4326
   )
 
   # Spatially aggregate
@@ -220,7 +218,18 @@ isoline <- function(poi, datetime = Sys.time(), arrival = FALSE,
           departure = if (arrival) NA else df$departure$time,
           arrival = if (arrival) df$arrival$time else NA,
           range = df$isolines$range$value,
-          geometry = sapply(df$isolines$polygons, function(x) x$outer)
+          geometry = lapply(df$isolines$polygons, function(x) {
+            # Decode flexible polyline encoding to ...
+            if (length(x$outer) > 1) {
+              # MULTIPOLYGON
+              sf::st_multipolygon(
+                sf::st_geometry(flexpolyline::decode_sf(x$outer, 4326))
+              )
+            } else {
+              # POLYGON
+              sf::st_geometry(flexpolyline::decode_sf(x$outer, 4326))[[1]]
+            }
+          })
         )
       })
     ),
@@ -232,11 +241,6 @@ isoline <- function(poi, datetime = Sys.time(), arrival = FALSE,
     return(NULL)
   }
 
-  # Decode flexible polyline encoding to POLYGON
-  geometry <- NULL
-  isolines[, "geometry" := sf::st_geometry(
-    flexpolyline::decode_sf(geometry, 4326)
-  )]
   return(isolines)
 }