1
#' HERE Traffic API: Incidents
2
#'
3
#' Traffic incident information from the HERE 'Traffic' API in areas of interest (AOIs).
4
#' The incidents contain information about location, duration, severity, type, description and further details.
5
#'
6
#' @references
7
#' \href{https://developer.here.com/documentation/traffic/dev_guide/topics/resource-parameters-incidents.html}{HERE Traffic API: Incidents}
8
#'
9
#' @param aoi \code{sf} object, Areas of Interest (POIs) of geometry type \code{POLYGON}.
10
#' @param from \code{POSIXct} object, datetime of the earliest traffic incidents (\code{default = FALSE}).
11
#' @param url_only boolean, only return the generated URLs (\code{default = FALSE})?
12
#'
13
#' @return
14
#' An \code{sf} object containing the traffic incidents.
15
#' @export
16
#'
17
#' @note
18
#' The maximum width and height of the bounding box of the input AOIs is 10 degrees.
19
#' This means that each polygon (= one row) in the AOI \code{sf} object should fit in a 10 x 10 degree bbox.
20
#'
21
#' @examples
22
#' # Provide an API Key for a HERE project
23
#' set_key("<YOUR API KEY>")
24
#'
25
#' # All traffic incidents from the beginning of 2018
26
#' incidents <- incident(
27
#'   aoi = aoi,
28
#'   from = as.POSIXct("2018-01-01 00:00:00"),
29
#'   url_only = TRUE
30
#' )
31
incident <- function(aoi, from = Sys.time() - 60*60*24*7, url_only = FALSE) {
32

33
  # Checks
34 1
  .check_polygon(aoi)
35 1
  .check_datetime(from)
36 1
  .check_boolean(url_only)
37

38
  # Add API key
39 1
  url <- .add_key(
40 1
    url = "https://traffic.ls.hereapi.com/traffic/6.2/incidents.json?"
41
  )
42

43
  # Add bbox
44 1
  aoi <- sf::st_transform(aoi, 4326)
45 1
  bbox <- sapply(sf::st_geometry(aoi), sf::st_bbox)
46 1
  .check_bbox(bbox)
47 1
  url <- paste0(
48 1
    url,
49 1
    "&bbox=",
50 1
    bbox[4, ], ",", bbox[1, ], ";",
51 1
    bbox[2, ], ",", bbox[3, ]
52
  )
53

54
  # Response attributes
55
  # url <- paste0(
56
  #   url,
57
  #   "&responseattributes=shape"
58
  # )
59

60
  # Add datetime range
61 1
  url <- .add_datetime(
62 1
    url = url,
63 1
    datetime = from,
64 1
    field_name = "startTime"
65
  )
66
  # url <- .add_datetime(
67
  #   url = url,
68
  #   datetime = to,
69
  #   field_name = "endTime"
70
  # )
71

72
  # Add utc time zone
73 1
  url <- paste0(
74 1
    url,
75 1
    "&localtime=false"
76
  )
77

78
  # Return urls if chosen
79 1
  if (url_only) return(url)
80

81
  # Request and get content
82 1
  data <- .get_content(
83 1
    url = url
84
  )
85 0
  if (length(data) == 0) return(NULL)
86

87
  # Extract information
88 1
  incident <- .extract_traffic_incidents(data)
89

90
  # Check for empty response
91 0
  if (is.null(incident)) {return(NULL)}
92

93
  # Spatial contains
94 1
  incident <-
95 1
    incident[Reduce(c, suppressMessages(sf::st_contains(aoi, incident))), ]
96 1
  rownames(incident) <- NULL
97 1
  return(sf::st_as_sf(as.data.frame(incident)))
98
}
99

100
.extract_traffic_incidents <- function(data) {
101
  #geoms_line <- list()
102 1
  ids <- .get_ids(data)
103 1
  count <- 0
104 1
  incidents <- data.table::rbindlist(lapply(data, function(con) {
105 1
    count <<- count + 1
106 1
    df <- jsonlite::fromJSON(con)
107 1
    if (is.null(df$TRAFFIC_ITEMS)) {return(NULL)}
108 1
    info <- data.table::data.table(
109 1
      id = ids[count],
110 1
      incidentId = df$TRAFFIC_ITEMS$TRAFFIC_ITEM$TRAFFIC_ITEM_ID,
111 1
      entryTime = .parse_datetime(df$TRAFFIC_ITEMS$TRAFFIC_ITEM$ENTRY_TIME, format = "%m/%d/%Y %H:%M:%OS"),
112 1
      fromTime = .parse_datetime(df$TRAFFIC_ITEMS$TRAFFIC_ITEM$START_TIME, format = "%m/%d/%Y %H:%M:%OS"),
113 1
      toTime = .parse_datetime(df$TRAFFIC_ITEMS$TRAFFIC_ITEM$END_TIME, format = "%m/%d/%Y %H:%M:%OS"),
114 1
      status = tolower(df$TRAFFIC_ITEMS$TRAFFIC_ITEM$TRAFFIC_ITEM_STATUS_SHORT_DESC),
115 1
      type = tolower(df$TRAFFIC_ITEMS$TRAFFIC_ITEM$TRAFFIC_ITEM_TYPE_DESC),
116 1
      verified = df$TRAFFIC_ITEMS$TRAFFIC_ITEM$VERIFIED,
117 1
      criticality = as.numeric(df$TRAFFIC_ITEMS$TRAFFIC_ITEM$CRITICALITY$ID),
118 1
      roadClosed = df$TRAFFIC_ITEMS$TRAFFIC_ITEM$TRAFFIC_ITEM_DETAIL$ROAD_CLOSED,
119 1
      locationName = df$TRAFFIC_ITEMS$TRAFFIC_ITEM$LOCATION$POLITICAL_BOUNDARY$COUNTY,
120 1
      lng = df$TRAFFIC_ITEMS$TRAFFIC_ITEM$LOCATION$GEOLOC$ORIGIN$LONGITUDE,
121 1
      lat = df$TRAFFIC_ITEMS$TRAFFIC_ITEM$LOCATION$GEOLOC$ORIGIN$LATITUDE,
122 1
      description = sapply(df$TRAFFIC_ITEMS$TRAFFIC_ITEM$TRAFFIC_ITEM_DESCRIPTION, function(x) x$value[2])
123
    )
124
    # geometry_line <- lapply(df$TRAFFIC_ITEMS$TRAFFIC_ITEM$LOCATION$GEOLOC$GEOMETRY$SHAPES$SHP, function(shp) {
125
    #   lines <- lapply(shp$value, function(pointList) {
126
    #     .line_from_pointList(strsplit(pointList, " ")[[1]])
127
    #   })
128
    #   if (length(lines) > 1) {sf::st_multilinestring(lines)}
129
    # })
130
    # geoms_line <<- append(geoms_line, geometry_line)
131
    # return(info)
132 1
  }), fill = TRUE)
133
  #incidents$geometry_line <- geoms_line
134

135
  # Create sf, data.frame
136 1
  if (nrow(incidents) > 0) {
137 1
    return(
138 1
      sf::st_set_crs(
139 1
        sf::st_as_sf(
140 1
          as.data.frame(incidents),
141 1
          coords = c("lng", "lat")
142 1
        ), 4326
143
      )
144
    )
145
  } else {
146 0
    return(NULL)
147
  }
148
}

Read our documentation on viewing source code .

Loading