1
.check_addresses <- function(addresses) {
2 1
  if (!is.character(addresses)) {
3 1
    stop(sprintf(
4 1
      "'%s' must be a 'character' vector.",
5 1
      deparse(substitute(addresses))
6
    ))
7
  }
8 1
  if (any(is.na(addresses))) {
9 1
    stop(sprintf(
10 1
      "'%s' contains NAs.",
11 1
      deparse(substitute(addresses))
12
    ))
13
  }
14 1
  if ("" %in% gsub(" ", "", addresses)) {
15 1
    stop(sprintf(
16 1
      "'%s' contains empty strings.",
17 1
      deparse(substitute(addresses))
18
    ))
19
  }
20
}
21

22
.check_points <- function(points) {
23 1
  if (!"sf" %in% class(points)) {
24 1
    stop(sprintf(
25 1
      "'%s' must be an sf object.",
26 1
      deparse(substitute(points))
27
    ))
28
  }
29 1
  if (any(sf::st_is_empty(points))) {
30 1
    stop(sprintf(
31 1
      "'%s' has empty entries in the geometry column.",
32 1
      deparse(substitute(points))
33
    ))
34
  }
35 1
  if (any(sf::st_geometry_type(points) != "POINT")) {
36 1
    stop(sprintf(
37 1
      "'%s' must be an sf object with geometry type 'POINT'.",
38 1
      deparse(substitute(points))
39
    ))
40
  }
41
}
42

43
.check_polygon <- function(polygon) {
44 1
  if (!"sf" %in% class(polygon)) {
45 1
    stop(sprintf(
46 1
      "'%s' must be an sf object.",
47 1
      deparse(substitute(polygon))
48
    ))
49
  }
50 1
  if (any(sf::st_is_empty(polygon))) {
51 1
    stop(sprintf(
52 1
      "'%s' has empty entries in the geometry column.",
53 1
      deparse(substitute(polygon))
54
    ))
55
  }
56 1
  if (!"sf" %in% class(polygon) |
57 1
    any(!(
58 1
      sf::st_geometry_type(polygon) %in% c("POLYGON", "MULTIPOLYGON")
59
    ))) {
60 1
    stop(sprintf(
61 1
      "'%s' must be an sf object with geometry type 'POLYGON' or 'MULTIPOLYGON'.",
62 1
      deparse(substitute(polygon))
63
    ))
64
  }
65
}
66

67
.check_input_rows <- function(x, y) {
68 1
  if (nrow(x) != nrow(y))
69 1
    stop(
70 1
      sprintf(
71 1
        "'%s' must have the same number of rows as '%s'.",
72 1
        deparse(substitute(x)), deparse(substitute(y))
73
      )
74
    )
75
}
76

77
.check_bbox <- function(bbox) {
78 1
  if (any(c(bbox[3, ] - bbox[1, ], bbox[4, ] - bbox[2, ]) >= 10)) {
79 0
    stop("The polygons in 'aoi' must fit in a 10 x 10 degree bbox.")
80
  }
81
}
82

83
.check_boolean <- function(bool) {
84 1
  if (!bool %in% c(TRUE, FALSE)) {
85 1
    stop(sprintf("'%s' must be a 'boolean' value.", deparse(substitute(bool))))
86
  }
87
}
88

89
.check_datetime <- function(datetime) {
90 1
  if (!any(class(datetime) %in% c("POSIXct", "POSIXt")) &
91 1
    !is.null(datetime)) {
92 1
    stop(sprintf(
93 1
      "'%s' must be of type 'POSIXct', 'POSIXt'.",
94 1
      deparse(substitute(datetime))
95
    ))
96
  }
97
}
98

99
.check_mode <- function(mode, request) {
100 1
  modes <- c(
101 1
    "car",
102 1
    "pedestrian",
103 1
    "carHOV",
104 1
    "publicTransport",
105 1
    "publicTransportTimeTable",
106 1
    "truck",
107 1
    "bicycle"
108
  )
109 1
  if (request == "calculateisoline") {
110 1
    modes <- modes[c(1, 2, 6)]
111 1
    if (!mode %in% modes) {
112 1
      stop(.stop_print_modes(mode = mode, modes = modes, request = request))
113
    }
114 1
  } else if (request == "calculatematrix") {
115 1
    modes <- modes[c(1, 2, 3, 6)]
116 1
    if (!mode %in% modes) {
117 1
      stop(.stop_print_modes(mode = mode, modes = modes, request = request))
118
    }
119 1
  } else if (request == "calculateroute") {
120 1
    modes <- modes[c(1, 2, 3, 4, 6, 7)]
121 1
    if (!mode %in% modes) {
122 1
      stop(.stop_print_modes(mode = mode, modes = modes, request = request))
123
    }
124
  }
125
}
126

127
.stop_print_modes <- function(mode, modes, request) {
128 1
  sprintf(
129 1
    "Transport mode '%s' not valid. For '%s' requests the mode must be in ('%s').",
130 1
    mode,
131 1
    request,
132 1
    paste(modes, collapse = "', '")
133
  )
134
}
135

136
.check_type <- function(type, request) {
137 1
  types <- c("fastest", "shortest", "balanced")
138 1
  if (request == "calculateisoline") {
139 1
    types <- types[c(1, 2)]
140 1
    if (!type %in% types) {
141 1
      stop(.stop_print_types(type = type, types = types, request = request))
142
    }
143 1
  } else if (request == "calculatematrix" |
144 1
    request == "calculateroute") {
145 1
    if (!type %in% types) {
146 1
      stop(.stop_print_types(type = type, types = types, request = request))
147
    }
148
  } else {
149 0
    stop(sprintf("'%s' is an invalid request type.", request))
150
  }
151
}
152

153
.stop_print_types <- function(type, types, request) {
154 1
  sprintf(
155 1
    "Routing type '%s' not valid. For '%s' requests the type must be in ('%s').",
156 1
    type,
157 1
    request,
158 1
    paste(types, collapse = "', '")
159
  )
160
}
161

162
.check_attributes <- function(attribute) {
163 1
  attributes <- c("distance", "traveltime")
164 1
  if (any(!attribute %in% attributes)) {
165 1
    stop(sprintf(
166 1
      "'attribute' must be in '%s'.",
167 1
      paste(attributes, collapse = "', '")
168
    ))
169
  }
170
}
171

172
.check_range_type <- function(range_type) {
173 1
  range_types <- c("distance", "time", "consumption")
174 1
  if (!range_type %in% range_types) {
175 1
    stop(sprintf(
176 1
      "'range_type' must be '%s'.",
177 1
      paste(range_types, collapse = "', '")
178
    ))
179
  }
180
}
181

182
.check_key <- function(api_key) {
183 1
  if (!(is.character(api_key) & api_key != "")) {
184 1
    stop(
185 1
      "Please provide an 'API key' for a HERE project.
186 1
         Get your login here: https://developer.here.com/"
187
    )
188
  }
189
}
190

191
.check_vehicle_type <- function(vehicle_type) {
192 1
  vehicle_types <- c("diesel", "gasoline", "electric")
193 1
  if (!strsplit(vehicle_type, ",")[[1]][1] %in% vehicle_types) {
194 1
    stop(sprintf(
195 1
      "'vehicle_type' must be '%s'.",
196 1
      paste(vehicle_types, collapse = "', '")
197
    ))
198
  }
199
}
200

201
.check_weather_product <- function(product) {
202 1
  weather_product_types <-
203 1
    c(
204 1
      "observation",
205 1
      "forecast_hourly",
206 1
      "forecast_astronomy",
207 1
      "alerts"
208
    )
209 1
  if (!product %in% weather_product_types) {
210 1
    stop(sprintf(
211 1
      "'product' must be '%s'.",
212 1
      paste(weather_product_types, collapse = "', '")
213
    ))
214
  }
215
}
216

217
.check_min_jam_factor <- function(min_jam_factor) {
218 1
  if (!is.numeric(min_jam_factor)) {
219 1
    stop("'min_jam_factor' must be of type 'numeric'.")
220
  }
221 1
  if (min_jam_factor < 0 | min_jam_factor > 10) {
222 1
    stop("'min_jam_factor' must be in the valid range from 0 to 10.")
223
  }
224
}
225

226
.check_numeric_range <- function(num, lower, upper) {
227 1
  var_name <- deparse(substitute(num))
228 1
  if (!is.numeric(num)) {
229 1
    stop(sprintf("'%s' must be of type 'numeric'.", var_name))
230
  }
231 1
  if (num < lower | num > upper) {
232 1
    stop(sprintf(
233 1
      "'%s' must be in the valid range from %s to %s.",
234 1
      var_name,
235 1
      lower,
236 1
      upper
237
    ))
238
  }
239
}

Read our documentation on viewing source code .

Loading