1
#' HERE Traffic API: Flow
2
#'
3
#' Real-time traffic flow from the HERE 'Traffic' API in areas of interest (AOIs).
4
#' The traffic flow data contains speed (\code{"SP"}) and congestion (jam factor: \code{"JF"}) information,
5
#' which corresponds to the status of the traffic at the time of the query.
6
#'
7
#' @references
8
#' \itemize{
9
#'   \item\href{https://developer.here.com/documentation/traffic/dev_guide/topics_v6.1/resource-parameters-flow.html}{HERE Traffic API: Flow}
10
#'   \item\href{https://stackoverflow.com/questions/28476762/reading-traffic-flow-data-from-here-maps-rest-api}{Flow explanation, stackoverflow}
11
#' }
12
#'
13
#' @param aoi \code{sf} object, Areas of Interest (POIs) of geometry type \code{POLYGON}.
14
#' @param min_jam_factor numeric, only retrieve flow information with a jam factor greater than the value provided (\code{default = 0}).
15
#' @param url_only boolean, only return the generated URLs (\code{default = FALSE})?
16
#'
17
#' @return
18
#' An \code{sf} object containing the requested traffic flow information.
19
#' @export
20
#'
21
#' @note
22
#' The maximum width and height of the bounding box of the input AOIs is 10 degrees.
23
#' This means that each polygon (= one row) in the AOI \code{sf} object should fit in a 10 x 10 degree bbox.
24
#'
25
#' Explanation of the traffic flow variables:
26
#' \itemize{
27
#'   \item\code{"PC"}: Point TMC location code.
28
#'   \item\code{"DE"}: Text description of the road.
29
#'   \item\code{"QD"}: Queuing direction. '+' or '-'. Note this is the opposite of the travel direction in the fully qualified ID, For example for location 107+03021 the QD would be '-'.
30
#'   \item\code{"LE"}: Length of the stretch of road.
31
#'   \item\code{"TY"}: Type information for the given Location Referencing container. This may be a freely defined string.
32
#'   \item\code{"SP"}: Speed (based on UNITS) capped by speed limit.
33
#'   \item\code{"FF"}: The free flow speed on this stretch of the road.
34
#'   \item\code{"JF"}: The number between 0.0 and 10.0 indicating the expected quality of travel. When there is a road closure, the Jam Factor will be 10. As the number approaches 10.0 the quality of travel is getting worse. -1.0 indicates that a Jam Factor could not be calculated.
35
#'   \item\code{"CN"}: Confidence, an indication of how the speed was determined. -1.0 road closed. 1.0=100\%.
36
#' }
37
#'
38
#' @examples
39
#' # Provide an API Key for a HERE project
40
#' set_key("<YOUR API KEY>")
41
#'
42
#' # Real-time traffic flow
43
#' flow <- flow(
44
#'   aoi = aoi[aoi$code == "LI", ],
45
#'   url_only = TRUE
46
#' )
47
flow <- function(aoi, min_jam_factor = 0, url_only = FALSE) {
48

49
  # Checks
50 1
  .check_polygon(aoi)
51 1
  .check_min_jam_factor(min_jam_factor)
52 1
  .check_boolean(url_only)
53

54
  # Add API key
55 1
  url <- .add_key(
56 1
    url = "https://traffic.ls.hereapi.com/traffic/6.2/flow.json?"
57
  )
58

59
  # Add bbox
60 1
  aoi <- sf::st_transform(aoi, 4326)
61 1
  bbox <- sapply(sf::st_geometry(aoi), sf::st_bbox)
62 1
  .check_bbox(bbox)
63 1
  url <- paste0(
64 1
    url,
65 1
    "&bbox=",
66 1
    bbox[4, ], ",", bbox[1, ], ";",
67 1
    bbox[2, ], ",", bbox[3, ]
68
  )
69

70
  # Response attributes
71 1
  url <- paste0(
72 1
    url,
73 1
    "&responseattributes=shape"
74
  )
75

76
  # Add min jam factor
77 1
    url <- paste0(
78 1
    url,
79 1
    "&minjamfactor=",
80 1
    min_jam_factor
81
  )
82

83
  # Return urls if chosen
84 1
  if (url_only) return(url)
85

86
  # Request and get content
87 1
  data <- .get_content(
88 1
    url = url
89
  )
90 0
  if (length(data) == 0) return(NULL)
91

92
  # Extract information
93 1
  flow <- .extract_traffic_flow(data, min_jam_factor)
94

95
  # Check for empty response
96 0
  if (is.null(flow)) {return(NULL)}
97

98
  # Spatial contains
99 1
  flow <-
100 1
    flow[Reduce(c, suppressMessages(sf::st_contains(aoi, flow))), ]
101 1
  rownames(flow) <- NULL
102 1
  return(flow)
103
}
104

105
.extract_traffic_flow <- function(data, min_jam_factor) {
106 1
  ids <- .get_ids(data)
107 1
  count <- 0
108 1
  geoms <- list()
109 1
  flow <- suppressWarnings(data.table::rbindlist(lapply(data, function(con) {
110 1
    count <<- count + 1
111 1
    df <- jsonlite::fromJSON(con)
112 0
    if (is.null(df$RWS$RW)) {return(NULL)}
113 1
    data.table::rbindlist(lapply(df$RWS$RW, function(rw) {
114 1
      data.table::rbindlist(lapply(rw$FIS, function(fis) {
115 1
        data.table::rbindlist(lapply(fis$FI, function(fi) {
116 1
          dat <- data.table::data.table(
117 1
            id = ids[count],
118 1
            cbind(
119 1
              fi$TM[, c("PC", "DE", "QD", "LE")],
120 1
              data.table::rbindlist(
121 1
                fi$CF, fill = TRUE
122 1
              )[, c("TY", "SP", "FF", "JF","CN")]
123
            )
124
          )
125 1
          geoms <<- append(geoms,
126 1
            geometry <- lapply(fi$SHP, function(shp) {
127 1
              lines <- lapply(shp$value, function(pointList) {
128 1
                .line_from_pointList(strsplit(pointList, " ")[[1]])
129
              })
130 1
              sf::st_multilinestring(lines)
131
            })
132
          )
133 1
          return(dat)
134 1
          }), fill = TRUE)
135 1
        }), fill = TRUE)
136 1
      }), fill = TRUE)
137 1
    }), fill = TRUE))
138 1
  flow$geometry <- geoms
139 1
  flow <- flow[flow$JF >= min_jam_factor, ]
140 1
  if (nrow(flow) > 0) {
141 1
    return(
142 1
      sf::st_set_crs(
143 1
        sf::st_as_sf(
144 1
          as.data.frame(flow)
145 1
        ), 4326
146
      )
147
    )
148
  } else {
149 0
    return(NULL)
150
  }
151
}

Read our documentation on viewing source code .

Loading