munterfinger / hereR
Showing 15 of 48 files from the diff.
Newly tracked file
R/options.R changed.

@@ -101,8 +101,9 @@
Loading
101 101
  }
102 102
103 103
  # Request and get content
104 -
  data <- .get_content(
105 -
    url = url
104 +
  data <- .async_request(
105 +
    url = url,
106 +
    rps = 5
106 107
  )
107 108
  if (length(data) == 0) {
108 109
    return(NULL)

@@ -211,3 +211,18 @@
Loading
211 211
    ))
212 212
  }
213 213
}
214 +
215 +
.check_internet <- function() {
216 +
  access <- tryCatch(
217 +
    {
218 +
      curl::has_internet()
219 +
    },
220 +
    error = function(cond) {
221 +
      warning(cond)
222 +
      return(FALSE)
223 +
    }
224 +
  )
225 +
  if (!access) {
226 +
    stop("Connection error: Please check internet access and proxy configuration.")
227 +
  }
228 +
}

@@ -59,3 +59,30 @@
Loading
59 59
    Sys.unsetenv("HERE_VERBOSE")
60 60
  }
61 61
}
62 +
63 +
#' Limit requests to the APIs
64 +
#'
65 +
#' If set to \code{TRUE} the hereR package limits the requests per second (RPS)
66 +
#' sent to the APIs. This option is necessary for freemium licenses to avoid
67 +
#' hitting the rate limit of the APIs with status code 429. Deactivate this
68 +
#' option to increase speed of requests for paid plans.
69 +
#'
70 +
#' @param ans boolean, use limits or not (default = \code{TRUE})?
71 +
#'
72 +
#' @return
73 +
#' None.
74 +
#'
75 +
#' @export
76 +
#'
77 +
#' @examples
78 +
#' set_rate_limit(FALSE)
79 +
set_rate_limit <- function(ans = TRUE) {
80 +
  .check_boolean(ans)
81 +
  if (!ans) {
82 +
    Sys.setenv(
83 +
      "HERE_RPS" = "FALSE"
84 +
    )
85 +
  } else {
86 +
    Sys.unsetenv("HERE_RPS")
87 +
  }
88 +
}

@@ -16,8 +16,6 @@
Loading
16 16
#' @param transport_mode character, set the transport mode: \code{"car"}, \code{"truck"}, \code{"pedestrian"} or \code{"bicycle"} (\code{default = "car"}).
17 17
#' @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.
18 18
#' @param url_only boolean, only return the generated URLs (\code{default = FALSE})?
19 -
#' @param type character, 'type' is deprecated, use 'routing_mode' instead.
20 -
#' @param mode character, 'mode' is deprecated, use 'transport_mode' instead.
21 19
#'
22 20
#' @return
23 21
#' A \code{data.frame}, which is an edge list containing the requested M:N route combinations.
@@ -34,17 +32,7 @@
Loading
34 32
#' )
35 33
route_matrix <- function(origin, destination = origin, datetime = Sys.time(),
36 34
                         routing_mode = "fast", transport_mode = "car",
37 -
                         traffic = TRUE, url_only = FALSE, type, mode) {
38 -
39 -
  # Deprecated parameters
40 -
  if (!missing("type")) {
41 -
    warning("'type' is deprecated, use 'routing_mode' instead.")
42 -
    routing_mode <- type
43 -
  }
44 -
  if (!missing("mode")) {
45 -
    warning("'mode' is deprecated, use 'transport_mode' instead.")
46 -
    transport_mode <- mode
47 -
  }
35 +
                         traffic = TRUE, url_only = FALSE) {
48 36
49 37
  # Checks
50 38
  .check_points(origin)
@@ -126,8 +114,9 @@
Loading
126 114
  }
127 115
128 116
  # Request and get content
129 -
  data <- .get_content(
130 -
    url = url
117 +
  data <- .async_request(
118 +
    url = url,
119 +
    rps = 1
131 120
  )
132 121
  if (length(data) == 0) {
133 122
    return(NULL)

@@ -19,8 +19,6 @@
Loading
19 19
#' @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).
20 20
#' @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})?
21 21
#' @param url_only boolean, only return the generated URLs (\code{default = FALSE})?
22 -
#' @param type character, 'type' is deprecated, use 'routing_mode' instead.
23 -
#' @param mode character, 'mode' is deprecated, use 'transport_mode' instead.
24 22
#'
25 23
#' @return
26 24
#' An \code{sf} object containing the requested isolines.
@@ -41,17 +39,7 @@
Loading
41 39
                    routing_mode = "fast", transport_mode = "car",
42 40
                    traffic = TRUE, optimize = "balanced",
43 41
                    consumption_model = NULL, aggregate = TRUE,
44 -
                    url_only = FALSE, type, mode) {
45 -
46 -
  # Deprecated parameters
47 -
  if (!missing("type")) {
48 -
    warning("'type' is deprecated, use 'routing_mode' instead.")
49 -
    routing_mode <- type
50 -
  }
51 -
  if (!missing("mode")) {
52 -
    warning("'mode' is deprecated, use 'transport_mode' instead.")
53 -
    transport_mode <- mode
54 -
  }
42 +
                    url_only = FALSE) {
55 43
56 44
  # Checks
57 45
  .check_points(poi)
@@ -151,8 +139,9 @@
Loading
151 139
  }
152 140
153 141
  # Request and get content
154 -
  data <- .get_content(
155 -
    url = url
142 +
  data <- .async_request(
143 +
    url = url,
144 +
    rps = 1
156 145
  )
157 146
  if (length(data) == 0) {
158 147
    return(NULL)
159 148
imilarity index 66%
160 149
ename from R/authentication.R
161 150
ename to R/options.R

@@ -34,7 +34,7 @@
Loading
34 34
  url <- paste0(
35 35
    url,
36 36
    "&q=",
37 -
    address
37 +
    curl::curl_escape(address)
38 38
  )
39 39
40 40
  # Add bbox containing the world
@@ -56,8 +56,9 @@
Loading
56 56
  }
57 57
58 58
  # Request and get content
59 -
  data <- .get_content(
60 -
    url = url
59 +
  data <- .async_request(
60 +
    url = url,
61 +
    rps = 5
61 62
  )
62 63
  if (length(data) == 0) {
63 64
    return(NULL)

@@ -50,7 +50,7 @@
Loading
50 50
  url <- paste0(
51 51
    url,
52 52
    "&q=",
53 -
    gsub("\\|", "", address)
53 +
    curl::curl_escape(address)
54 54
  )
55 55
56 56
  # Return urls if chosen
@@ -59,8 +59,9 @@
Loading
59 59
  }
60 60
61 61
  # Request and get content
62 -
  data <- .get_content(
63 -
    url = url
62 +
  data <- .async_request(
63 +
    url = url,
64 +
    rps = 5
64 65
  )
65 66
  if (length(data) == 0) {
66 67
    return(NULL)

@@ -19,8 +19,6 @@
Loading
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 20
#' @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 21
#' @param url_only boolean, only return the generated URLs (\code{default = FALSE})?
22 -
#' @param type character, 'type' is deprecated, use 'routing_mode' instead.
23 -
#' @param mode character, 'mode' is deprecated, use 'transport_mode' instead.
24 22
#'
25 23
#' @return
26 24
#' An \code{sf} object containing the requested routes.
@@ -44,18 +42,7 @@
Loading
44 42
#' )
45 43
route <- function(origin, destination, datetime = Sys.time(), arrival = FALSE,
46 44
                  results = 1, routing_mode = "fast", transport_mode = "car",
47 -
                  traffic = TRUE, consumption_model = NULL, url_only = FALSE,
48 -
                  type, mode) {
49 -
50 -
  # Deprecated parameters
51 -
  if (!missing("type")) {
52 -
    warning("'type' is deprecated, use 'routing_mode' instead.")
53 -
    routing_mode <- type
54 -
  }
55 -
  if (!missing("mode")) {
56 -
    warning("'mode' is deprecated, use 'transport_mode' instead.")
57 -
    transport_mode <- mode
58 -
  }
45 +
                  traffic = TRUE, consumption_model = NULL, url_only = FALSE) {
59 46
60 47
  # Checks
61 48
  .check_points(origin)
@@ -149,8 +136,9 @@
Loading
149 136
  }
150 137
151 138
  # Request and get content
152 -
  data <- .get_content(
153 -
    url = url
139 +
  data <- .async_request(
140 +
    url = url,
141 +
    rps = 10
154 142
  )
155 143
  if (length(data) == 0) {
156 144
    return(NULL)

@@ -86,8 +86,9 @@
Loading
86 86
  }
87 87
88 88
  # Request and get content
89 -
  data <- .get_content(
90 -
    url = url
89 +
  data <- .async_request(
90 +
    url = url,
91 +
    rps = Inf
91 92
  )
92 93
  if (length(data) == 0) {
93 94
    return(NULL)

@@ -62,8 +62,9 @@
Loading
62 62
  }
63 63
64 64
  # Request and get content
65 -
  data <- .get_content(
66 -
    url = url
65 +
  data <- .async_request(
66 +
    url = url,
67 +
    rps = 10
67 68
  )
68 69
  if (length(data) == 0) {
69 70
    return(NULL)

@@ -70,8 +70,9 @@
Loading
70 70
  }
71 71
72 72
  # Request and get content
73 -
  data <- .get_content(
74 -
    url = url
73 +
  data <- .async_request(
74 +
    url = url,
75 +
    rps = Inf
75 76
  )
76 77
  if (length(data) == 0) {
77 78
    return(NULL)

@@ -58,7 +58,7 @@
Loading
58 58
    url <- paste0(
59 59
      url,
60 60
      "&name=",
61 -
      gsub("\\|", "", poi)
61 +
      curl::curl_escape(poi)
62 62
    )
63 63
    # sf POINTs
64 64
  } else if ("sf" %in% class(poi)) {
@@ -84,8 +84,9 @@
Loading
84 84
  }
85 85
86 86
  # Request and get content
87 -
  data <- .get_content(
88 -
    url = url
87 +
  data <- .async_request(
88 +
    url = url,
89 +
    rps = Inf
89 90
  )
90 91
  if (length(data) == 0) {
91 92
    return(NULL)

@@ -115,8 +115,9 @@
Loading
115 115
  }
116 116
117 117
  # Request and get content
118 -
  data <- .get_content(
119 -
    url = url
118 +
  data <- .async_request(
119 +
    url = url,
120 +
    rps = 10
120 121
  )
121 122
  if (length(data) == 0) {
122 123
    return(NULL)

@@ -45,77 +45,114 @@
Loading
45 45
46 46
47 47
## Requests
48 -
# Inspired by: https://hydroecology.net/asynchronous-web-requests-with-curl/
49 -
.get_content <- function(url, encoding = "UTF-8") {
50 -
  if (Sys.getenv("HERE_VERBOSE") != "") {
51 -
    message(
52 -
      sprintf(
53 -
        "Sending %s request(s) to: '%s?...'",
54 -
        length(url), strsplit(url[1], "\\?", )[[1]][1]
55 -
      )
56 -
    )
48 +
49 +
.async_request <- function(url, rps = Inf, ...) {
50 +
51 +
  .check_internet()
52 +
53 +
  # Check if rate limits are enabled
54 +
  if (!.get_rate_limits()) {
55 +
    rps <- Inf
57 56
  }
57 +
  .verbose_request(url, rps)
58 58
59 59
  # Split url strings into url, headers and request body (if any)
60 60
  url <- strsplit(url, " | ", fixed = TRUE)
61 61
62 -
  # Callback function generator - returns a callback function with ID
63 -
  results <- list()
64 -
  cb_gen <- function(id) {
65 -
    function(res) {
66 -
      if (is.character(res)) {
67 -
        stop("Connection error: Please check connection to the internet and proxy configuration.")
68 -
      }
69 -
      if (res$status != 200) {
70 -
        warning(
71 -
          sprintf(
72 -
            "Request 'id = %s' failed: Status %s. ",
73 -
            strsplit(id, "_")[[1]][2], res$status
74 -
          )
75 -
        )
76 -
        ids <<- ids[ids != id]
77 -
      } else {
78 -
        results[[id]] <<- res
79 -
      }
80 -
    }
81 -
  }
62 +
  # Options
63 +
  opt_list <- append(
64 +
    list(
65 +
      useragent = sprintf(
66 +
        "hereR/%s R/%s (%s)",
67 +
        utils::packageVersion("hereR"),
68 +
        getRversion(),
69 +
        R.Version()$platform
70 +
      )
71 +
    ),
72 +
    list(...)
73 +
  )
82 74
83 -
  # Define the IDs and callback functions
84 -
  ids <- paste0("request_", seq_along(url))
85 -
  cbs <- lapply(ids, cb_gen)
86 -
87 -
  # Add requests to pool and check for headers and request body
88 -
  pool <- curl::new_pool()
89 -
  lapply(seq_along(url), function(i) {
90 -
    handle <- curl::new_handle()
91 -
    if (length(url[[i]]) == 3) {
92 -
      curl::handle_setheaders(handle, .list = jsonlite::fromJSON(url[[i]][2]))
93 -
      curl::handle_setopt(handle, copypostfields = url[[i]][3])
94 -
    }
95 -
    curl::curl_fetch_multi(utils::URLencode(url[[i]][1]),
96 -
      pool = pool,
97 -
      done = cbs[[i]], fail = cbs[[i]],
98 -
      handle = handle
75 +
  # Construct requests: GET or POST
76 +
  reqs <- lapply(url, function(u) {
77 +
    req <- crul::HttpRequest$new(
78 +
      url = u[[1]],
79 +
      headers = list(Accept = "application/json", `Accept-Charset` = "utf-8"),
80 +
      opts = opt_list
99 81
    )
82 +
    if (length(u) == 3) {
83 +
      req$post(
84 +
        headers = jsonlite::fromJSON(u[[2]]),
85 +
        body = u[[3]]
86 +
      )
87 +
    } else {
88 +
      req$get()
89 +
    }
100 90
  })
101 91
102 -
  # Send requests and process the responses in the same order as the input URLs
103 -
  out <- curl::multi_run(pool = pool)
104 -
  results <- lapply(results[ids], function(x) {
105 -
    raw_char <- rawToChar(x$content)
106 -
    Encoding(raw_char) <- encoding
107 -
    raw_char
92 +
  # Process queue
93 +
  out <- crul::AsyncQueue$new(.list = reqs, bucket_size = rps, sleep = 1)
94 +
  out$request()
95 +
96 +
  # Parse result
97 +
  res_list <- lapply(seq_along(out$responses()), function(i) {
98 +
    .parse_response(i, out$responses()[[i]])
108 99
  })
100 +
  names(res_list) <- paste0("request_", seq_along(url))
101 +
  .verbose_response(res_list)
102 +
103 +
  # Filter on successful responses
104 +
  res_list <- Filter(Negate(is.null), res_list)
105 +
106 +
  return(res_list)
107 +
}
108 +
109 +
.get_verbose <- function() {
109 110
  if (Sys.getenv("HERE_VERBOSE") != "") {
111 +
    return(TRUE)
112 +
  } else {
113 +
    return(FALSE)
114 +
  }
115 +
}
116 +
117 +
.get_rate_limits <- function() {
118 +
  if (Sys.getenv("HERE_RPS") != "") {
119 +
    return(FALSE)
120 +
  } else {
121 +
    return(TRUE)
122 +
  }
123 +
}
124 +
125 +
.verbose_request <- function(url, rps) {
126 +
  if (.get_verbose()) {
127 +
    message(
128 +
      sprintf(
129 +
        "Sending %s request(s) with %s RPS to: '%s?...'",
130 +
        length(url), ifelse(is.infinite(rps), "unlimited", rps),
131 +
        strsplit(url, "\\?", )[[1]][1]
132 +
      )
133 +
    )
134 +
  }
135 +
}
136 +
137 +
.verbose_response <- function(res_list) {
138 +
  if (.get_verbose()) {
110 139
    message(
111 140
      sprintf(
112 141
        "Received %s response(s) with total size: %s",
113 -
        length(results),
114 -
        format(utils::object.size(results), units = "auto")
142 +
        length(res_list),
143 +
        format(utils::object.size(res_list), units = "auto")
115 144
      )
116 145
    )
117 146
  }
118 -
  results
147 +
}
148 +
149 +
.parse_response <- function(i, res) {
150 +
  if (res$status_code != 200) {
151 +
    warning(sprintf("Request 'id = %s' failed: Status %s. ", i, res$status_code))
152 +
    return(NULL)
153 +
  } else {
154 +
    return(res$parse("UTF-8"))
155 +
  }
119 156
}
120 157
121 158
.get_ids <- function(content) {

@@ -73,8 +73,9 @@
Loading
73 73
  }
74 74
75 75
  # Request and get content
76 -
  data <- .get_content(
77 -
    url = url
76 +
  data <- .async_request(
77 +
    url = url,
78 +
    rps = 5
78 79
  )
79 80
  if (length(data) == 0) {
80 81
    return(NULL)
Files Coverage
R 92.35%
Project Totals (16 files) 92.35%
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