munterfinger / hereR

@@ -53,7 +53,7 @@
Loading
53 53
  # Check and preprocess location
54 54
  # Character location (remove pipes)
55 55
  if (is.character(poi)) {
56 -
    .check_addresses(poi)
56 +
    .check_character(poi)
57 57
    poi[poi == ""] <- NA
58 58
    url <- paste0(
59 59
      url,

@@ -21,7 +21,7 @@
Loading
21 21
autosuggest <- function(address, results = 5, url_only = FALSE) {
22 22
23 23
  # Check addresses
24 -
  .check_addresses(address)
24 +
  .check_character(address)
25 25
  .check_numeric_range(results, 1, 100)
26 26
  .check_boolean(url_only)
27 27

@@ -36,7 +36,7 @@
Loading
36 36
geocode <- function(address, alternatives = FALSE, sf = TRUE, url_only = FALSE) {
37 37
38 38
  # Input checks
39 -
  .check_addresses(address)
39 +
  .check_character(address)
40 40
  .check_boolean(alternatives)
41 41
  .check_boolean(sf)
42 42
  .check_boolean(url_only)

@@ -17,6 +17,8 @@
Loading
17 17
#' @param routing_mode character, set the routing type: \code{"fast"} or \code{"short"} (\code{default = "fast"}).
18 18
#' @param transport_mode character, set the transport mode: \code{"car"}, \code{"truck"}, \code{"pedestrian"}, \code{"bicycle"} or \code{scooter} (\code{default = "car"}).
19 19
#' @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.
20 +
#' @param avoid_area, \code{sf} object, area (only bounding box is taken) to avoid in routes (\code{default = NULL}).
21 +
#' @param avoid_feature character, transport network features to avoid, e.g. \code{"tollRoad"} or \code{"ferry"} (\code{default = NULL}).
20 22
#' @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).
21 23
#' @param url_only boolean, only return the generated URLs (\code{default = FALSE})?
22 24
#'
@@ -42,7 +44,8 @@
Loading
42 44
#' )
43 45
route <- function(origin, destination, datetime = Sys.time(), arrival = FALSE,
44 46
                  results = 1, routing_mode = "fast", transport_mode = "car",
45 -
                  traffic = TRUE, consumption_model = NULL, url_only = FALSE) {
47 +
                  traffic = TRUE, avoid_area = NULL, avoid_feature = NULL,
48 +
                  consumption_model = NULL, url_only = FALSE) {
46 49
47 50
  # Checks
48 51
  .check_points(origin)
@@ -54,6 +57,8 @@
Loading
54 57
  .check_routing_mode(routing_mode)
55 58
  .check_transport_mode(transport_mode, request = "route")
56 59
  .check_boolean(traffic)
60 +
  .check_polygon(avoid_area)
61 +
  .check_character(avoid_feature)
57 62
  .check_boolean(url_only)
58 63
59 64
  # Arrival time is not yet supported by the API
@@ -106,6 +111,27 @@
Loading
106 111
    results - 1
107 112
  )
108 113
114 +
  # Add avoidance of a bound box
115 +
  if (!is.null(avoid_area)) {
116 +
    url <- paste0(
117 +
      url,
118 +
      "&avoid[areas]=bbox:",
119 +
      paste(
120 +
        sf::st_bbox(sf::st_transform(avoid_area, 4326)),
121 +
        collapse = ","
122 +
      )
123 +
    )
124 +
  }
125 +
126 +
  # Add avoidance of features
127 +
  if (!is.null(avoid_feature)) {
128 +
    url <- paste0(
129 +
      url,
130 +
      "&avoid[features]=",
131 +
      paste(avoid_feature, collapse = ",")
132 +
    )
133 +
  }
134 +
109 135
  # Add consumption model if specified, otherwise set to default electric vehicle
110 136
  if (is.null(consumption_model)) {
111 137
    url <- paste0(

@@ -1,20 +1,20 @@
Loading
1 -
.check_addresses <- function(addresses) {
2 -
  if (!is.character(addresses)) {
1 +
.check_character <- function(text) {
2 +
  if (!is.character(text) & !is.null(text)) {
3 3
    stop(sprintf(
4 4
      "'%s' must be a 'character' vector.",
5 -
      deparse(substitute(addresses))
5 +
      deparse(substitute(text))
6 6
    ))
7 7
  }
8 -
  if (any(is.na(addresses))) {
8 +
  if (any(is.na(text))) {
9 9
    stop(sprintf(
10 10
      "'%s' contains NAs.",
11 -
      deparse(substitute(addresses))
11 +
      deparse(substitute(text))
12 12
    ))
13 13
  }
14 -
  if ("" %in% gsub(" ", "", addresses)) {
14 +
  if ("" %in% gsub(" ", "", text)) {
15 15
    stop(sprintf(
16 16
      "'%s' contains empty strings.",
17 -
      deparse(substitute(addresses))
17 +
      deparse(substitute(text))
18 18
    ))
19 19
  }
20 20
}
@@ -41,26 +41,28 @@
Loading
41 41
}
42 42
43 43
.check_polygon <- function(polygon) {
44 -
  if (!"sf" %in% class(polygon)) {
45 -
    stop(sprintf(
46 -
      "'%s' must be an sf object.",
47 -
      deparse(substitute(polygon))
48 -
    ))
49 -
  }
50 -
  if (any(sf::st_is_empty(polygon))) {
51 -
    stop(sprintf(
52 -
      "'%s' has empty entries in the geometry column.",
53 -
      deparse(substitute(polygon))
54 -
    ))
55 -
  }
56 -
  if (!"sf" %in% class(polygon) |
57 -
    any(!(
58 -
      sf::st_geometry_type(polygon) %in% c("POLYGON", "MULTIPOLYGON")
59 -
    ))) {
60 -
    stop(sprintf(
61 -
      "'%s' must be an sf object with geometry type 'POLYGON' or 'MULTIPOLYGON'.",
62 -
      deparse(substitute(polygon))
63 -
    ))
44 +
  if (!is.null(polygon)) {
45 +
    if (!"sf" %in% class(polygon)) {
46 +
      stop(sprintf(
47 +
        "'%s' must be an sf object.",
48 +
        deparse(substitute(polygon))
49 +
      ))
50 +
    }
51 +
    if (any(sf::st_is_empty(polygon))) {
52 +
      stop(sprintf(
53 +
        "'%s' has empty entries in the geometry column.",
54 +
        deparse(substitute(polygon))
55 +
      ))
56 +
    }
57 +
    if (!"sf" %in% class(polygon) |
58 +
      any(!(
59 +
        sf::st_geometry_type(polygon) %in% c("POLYGON", "MULTIPOLYGON")
60 +
      ))) {
61 +
      stop(sprintf(
62 +
        "'%s' must be an sf object with geometry type 'POLYGON' or 'MULTIPOLYGON'.",
63 +
        deparse(substitute(polygon))
64 +
      ))
65 +
    }
64 66
  }
65 67
}
66 68

@@ -47,7 +47,6 @@
Loading
47 47
## Requests
48 48
49 49
.async_request <- function(url, rps = Inf, ...) {
50 -
51 50
  .check_internet()
52 51
53 52
  # Check if rate limits are enabled
Files Coverage
R 91.76%
Project Totals (16 files) 91.76%
1
comment: false
2

3
coverage:
4
  status:
5
    project:
6
      default:
7
        target: auto
8
        threshold: 1%
9
    patch:
10
      default:
11
        target: auto
12
        threshold: 1%
Sunburst
The inner-most circle is the entire project, moving away from the center are folders then, finally, a single file. The size and color of each slice is representing the number of statements and the coverage, respectively.
Icicle
The top section represents the entire project. Proceeding with folders and finally individual files. The size and color of each slice is representing the number of statements and the coverage, respectively.
Grid
Each block represents a single file in the project. The size and color of each block is represented by the number of statements and the coverage, respectively.
Loading