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)

@@ -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
@@ -140,6 +142,19 @@
Loading
140 142
  }
141 143
}
142 144
145 +
.check_optimize <- function(optimize) {
146 +
  optimizations <- c("balanced", "quality", "performance")
147 +
  if (!optimize %in% optimizations) {
148 +
    stop(
149 +
      sprintf(
150 +
        "Optimization method '%s' not valid, must be in ('%s').",
151 +
        optimize,
152 +
        paste(optimizations, collapse = "', '")
153 +
      )
154 +
    )
155 +
  }
156 +
}
157 +
143 158
.check_range_type <- function(range_type) {
144 159
  range_types <- c("distance", "time", "consumption")
145 160
  if (!range_type %in% range_types) {
@@ -198,3 +213,18 @@
Loading
198 213
    ))
199 214
  }
200 215
}
216 +
217 +
.check_internet <- function() {
218 +
  access <- tryCatch(
219 +
    {
220 +
      curl::has_internet()
221 +
    },
222 +
    error = function(cond) {
223 +
      warning(cond)
224 +
      return(FALSE)
225 +
    }
226 +
  )
227 +
  if (!access) {
228 +
    stop("Connection error: Please check internet access and proxy configuration.")
229 +
  }
230 +
}

@@ -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)

@@ -15,11 +15,10 @@
Loading
15 15
#' @param routing_mode character, set the routing mode: \code{"fast"} or \code{"short"}.
16 16
#' @param transport_mode character, set the transport mode: \code{"car"}, \code{"pedestrian"} or \code{"truck"}.
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 +
#' @param optimize, character, specifies how isoline calculation is optimized: \code{"balanced"}, \code{"quality"} or \code{"performance"} (\code{default = "balanced"}).
18 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).
19 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})?
20 21
#' @param url_only boolean, only return the generated URLs (\code{default = FALSE})?
21 -
#' @param type character, 'type' is deprecated, use 'routing_mode' instead.
22 -
#' @param mode character, 'mode' is deprecated, use 'transport_mode' instead.
23 22
#'
24 23
#' @return
25 24
#' An \code{sf} object containing the requested isolines.
@@ -38,18 +37,9 @@
Loading
38 37
isoline <- function(poi, datetime = Sys.time(), arrival = FALSE,
39 38
                    range = seq(5, 30, 5) * 60, range_type = "time",
40 39
                    routing_mode = "fast", transport_mode = "car",
41 -
                    traffic = TRUE, consumption_model = NULL,
42 -
                    aggregate = TRUE, url_only = FALSE, type, mode) {
43 -
44 -
  # Deprecated parameters
45 -
  if (!missing("type")) {
46 -
    warning("'type' is deprecated, use 'routing_mode' instead.")
47 -
    routing_mode <- type
48 -
  }
49 -
  if (!missing("mode")) {
50 -
    warning("'mode' is deprecated, use 'transport_mode' instead.")
51 -
    transport_mode <- mode
52 -
  }
40 +
                    traffic = TRUE, optimize = "balanced",
41 +
                    consumption_model = NULL, aggregate = TRUE,
42 +
                    url_only = FALSE) {
53 43
54 44
  # Checks
55 45
  .check_points(poi)
@@ -57,6 +47,7 @@
Loading
57 47
  .check_range_type(range_type)
58 48
  .check_routing_mode(routing_mode)
59 49
  .check_transport_mode(transport_mode, request = "isoline")
50 +
  .check_optimize(optimize)
60 51
  .check_boolean(traffic)
61 52
  .check_boolean(arrival)
62 53
  .check_boolean(aggregate)
@@ -111,6 +102,13 @@
Loading
111 102
    range_type
112 103
  )
113 104
105 +
  # Add optimization method
106 +
  url <- paste0(
107 +
    url,
108 +
    "&optimizeFor=",
109 +
    optimize
110 +
  )
111 +
114 112
  # Add consumption model if specified, otherwise set to default electric vehicle
115 113
  if (is.null(consumption_model)) {
116 114
    url <- paste0(
@@ -141,8 +139,9 @@
Loading
141 139
  }
142 140
143 141
  # Request and get content
144 -
  data <- .get_content(
145 -
    url = url
142 +
  data <- .async_request(
143 +
    url = url,
144 +
    rps = 1
146 145
  )
147 146
  if (length(data) == 0) {
148 147
    return(NULL)
@@ -180,8 +179,7 @@
Loading
180 179
  isolines <- sf::st_as_sf(
181 180
    isolines,
182 181
    sf_column_name = "geometry",
183 -
    crs = 4326,
184 -
    check_ring_dir = TRUE
182 +
    crs = 4326
185 183
  )
186 184
187 185
  # Spatially aggregate
@@ -220,7 +218,18 @@
Loading
220 218
          departure = if (arrival) NA else df$departure$time,
221 219
          arrival = if (arrival) df$arrival$time else NA,
222 220
          range = df$isolines$range$value,
223 -
          geometry = sapply(df$isolines$polygons, function(x) x$outer)
221 +
          geometry = lapply(df$isolines$polygons, function(x) {
222 +
            # Decode flexible polyline encoding to ...
223 +
            if (length(x$outer) > 1) {
224 +
              # MULTIPOLYGON
225 +
              sf::st_multipolygon(
226 +
                sf::st_geometry(flexpolyline::decode_sf(x$outer, 4326))
227 +
              )
228 +
            } else {
229 +
              # POLYGON
230 +
              sf::st_geometry(flexpolyline::decode_sf(x$outer, 4326))[[1]]
231 +
            }
232 +
          })
224 233
        )
225 234
      })
226 235
    ),
@@ -232,11 +241,6 @@
Loading
232 241
    return(NULL)
233 242
  }
234 243
235 -
  # Decode flexible polyline encoding to POLYGON
236 -
  geometry <- NULL
237 -
  isolines[, "geometry" := sf::st_geometry(
238 -
    flexpolyline::decode_sf(geometry, 4326)
239 -
  )]
240 244
  return(isolines)
241 245
}
242 246
243 247
imilarity index 66%
244 248
ename from R/authentication.R
245 249
ename to R/options.R

@@ -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
@@ -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)

@@ -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)
@@ -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)

@@ -17,10 +17,10 @@
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 -
#' @param type character, 'type' is deprecated, use 'routing_mode' instead.
23 -
#' @param mode character, 'mode' is deprecated, use 'transport_mode' instead.
24 24
#'
25 25
#' @return
26 26
#' An \code{sf} object containing the requested routes.
@@ -44,18 +44,8 @@
Loading
44 44
#' )
45 45
route <- function(origin, destination, datetime = Sys.time(), arrival = FALSE,
46 46
                  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 -
  }
47 +
                  traffic = TRUE, avoid_area = NULL, avoid_feature = NULL,
48 +
                  consumption_model = NULL, url_only = FALSE) {
59 49
60 50
  # Checks
61 51
  .check_points(origin)
@@ -67,6 +57,8 @@
Loading
67 57
  .check_routing_mode(routing_mode)
68 58
  .check_transport_mode(transport_mode, request = "route")
69 59
  .check_boolean(traffic)
60 +
  .check_polygon(avoid_area)
61 +
  .check_character(avoid_feature)
70 62
  .check_boolean(url_only)
71 63
72 64
  # Arrival time is not yet supported by the API
@@ -119,6 +111,27 @@
Loading
119 111
    results - 1
120 112
  )
121 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 +
122 135
  # Add consumption model if specified, otherwise set to default electric vehicle
123 136
  if (is.null(consumption_model)) {
124 137
    url <- paste0(
@@ -149,8 +162,9 @@
Loading
149 162
  }
150 163
151 164
  # Request and get content
152 -
  data <- .get_content(
153 -
    url = url
165 +
  data <- .async_request(
166 +
    url = url,
167 +
    rps = 10
154 168
  )
155 169
  if (length(data) == 0) {
156 170
    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)

@@ -53,12 +53,12 @@
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,
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,113 @@
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 +
  .check_internet()
51 +
52 +
  # Check if rate limits are enabled
53 +
  if (!.get_rate_limits()) {
54 +
    rps <- Inf
57 55
  }
56 +
  .verbose_request(url, rps)
58 57
59 58
  # Split url strings into url, headers and request body (if any)
60 59
  url <- strsplit(url, " | ", fixed = TRUE)
61 60
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 -
  }
61 +
  # Options
62 +
  opt_list <- append(
63 +
    list(
64 +
      useragent = sprintf(
65 +
        "hereR/%s R/%s (%s)",
66 +
        utils::packageVersion("hereR"),
67 +
        getRversion(),
68 +
        R.Version()$platform
69 +
      )
70 +
    ),
71 +
    list(...)
72 +
  )
82 73
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
74 +
  # Construct requests: GET or POST
75 +
  reqs <- lapply(url, function(u) {
76 +
    req <- crul::HttpRequest$new(
77 +
      url = u[[1]],
78 +
      headers = list(Accept = "application/json", `Accept-Charset` = "utf-8"),
79 +
      opts = opt_list
99 80
    )
81 +
    if (length(u) == 3) {
82 +
      req$post(
83 +
        headers = jsonlite::fromJSON(u[[2]]),
84 +
        body = u[[3]]
85 +
      )
86 +
    } else {
87 +
      req$get()
88 +
    }
100 89
  })
101 90
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
91 +
  # Process queue
92 +
  out <- crul::AsyncQueue$new(.list = reqs, bucket_size = rps, sleep = 1)
93 +
  out$request()
94 +
95 +
  # Parse result
96 +
  res_list <- lapply(seq_along(out$responses()), function(i) {
97 +
    .parse_response(i, out$responses()[[i]])
108 98
  })
99 +
  names(res_list) <- paste0("request_", seq_along(url))
100 +
  .verbose_response(res_list)
101 +
102 +
  # Filter on successful responses
103 +
  res_list <- Filter(Negate(is.null), res_list)
104 +
105 +
  return(res_list)
106 +
}
107 +
108 +
.get_verbose <- function() {
109 109
  if (Sys.getenv("HERE_VERBOSE") != "") {
110 +
    return(TRUE)
111 +
  } else {
112 +
    return(FALSE)
113 +
  }
114 +
}
115 +
116 +
.get_rate_limits <- function() {
117 +
  if (Sys.getenv("HERE_RPS") != "") {
118 +
    return(FALSE)
119 +
  } else {
120 +
    return(TRUE)
121 +
  }
122 +
}
123 +
124 +
.verbose_request <- function(url, rps) {
125 +
  if (.get_verbose()) {
126 +
    message(
127 +
      sprintf(
128 +
        "Sending %s request(s) with %s RPS to: '%s?...'",
129 +
        length(url), ifelse(is.infinite(rps), "unlimited", rps),
130 +
        strsplit(url, "\\?", )[[1]][1]
131 +
      )
132 +
    )
133 +
  }
134 +
}
135 +
136 +
.verbose_response <- function(res_list) {
137 +
  if (.get_verbose()) {
110 138
    message(
111 139
      sprintf(
112 140
        "Received %s response(s) with total size: %s",
113 -
        length(results),
114 -
        format(utils::object.size(results), units = "auto")
141 +
        length(res_list),
142 +
        format(utils::object.size(res_list), units = "auto")
115 143
      )
116 144
    )
117 145
  }
118 -
  results
146 +
}
147 +
148 +
.parse_response <- function(i, res) {
149 +
  if (res$status_code != 200) {
150 +
    warning(sprintf("Request 'id = %s' failed: Status %s. ", i, res$status_code))
151 +
    return(NULL)
152 +
  } else {
153 +
    return(res$parse("UTF-8"))
154 +
  }
119 155
}
120 156
121 157
.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 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