Merge pull request #115 from munterfinger/release/v0.6.1

Release/v0.6.1
munterfi · Feb 1, 2021 · 12789dc · 12789dc
2 parents 72332d0 + 1c1148d
commit 12789dc
Show file tree

Hide file tree

Showing 45 changed files with 591 additions and 358 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,7 +1,7 @@
 Package: hereR
 Type: Package
 Title: 'sf'-Based Interface to the 'HERE' REST APIs
-Version: 0.6.0
+Version: 0.6.1
 Authors@R: c(
     person("Merlin", "Unterfinger", role = c("aut", "cre"), email = "[email protected]", comment = c(ORCID = "0000-0003-2020-2366")),
     person("Daniel", "Possenriede", role = "ctb", comment = c(ORCID = "0000-0002-6738-9845")))

diff --git a/NEWS.md b/NEWS.md
@@ -1,3 +1,12 @@
+# version 0.6.1
+
+* Use **styler** package and use `tyler::tidyverse_style()`to format the package.
+* All **lintr** issues are solved, except from line length issues (limit of 80 characters).
+* Avoid drop of the `sfc` class of the geometry column when there is only one geometry/row in a `data.table` (closes [#111](https://github.com/munterfinger/hereR/issues/111)).
+* Return `queryScore` in `geocode()` results as `score` column (closes [#109](https://github.com/munterfinger/hereR/issues/109)).
+* Silence **sf** messages of `sf::st_union` call in `connection(..., summary = TRUE)`.
+* Added section id to `route()`, `intermodal_route()` and `connection()`.
+
 # version 0.6.0
 
 * Update `route_matrix()` from **Routing API v7.2** (calculatematrix) to **Matrix Routing API v8** (see [#87](https://github.com/munterfinger/hereR/issues/87)).

diff --git a/R/authentication.R b/R/authentication.R
@@ -4,7 +4,7 @@
 #' The key is set for the current R session and is used
 #' to authenticate in the requests to the APIs.
 #'
-#' No login yet? Get a free login and key here: \href{https://developer.here.com/}{klick}
+#' No login yet? Get a login and key here: \href{https://developer.here.com/}{klick}
 #'
 #' @param api_key character, the API key from a HERE project.
 #'
@@ -14,7 +14,7 @@
 #'
 #' @examples
 #' set_key("<YOUR API KEY>")
-set_key <- function(api_key){
+set_key <- function(api_key) {
   .check_key(api_key)
   Sys.setenv(
     "HERE_API_KEY" = api_key

diff --git a/R/autosuggest.R b/R/autosuggest.R
@@ -31,33 +31,37 @@ autosuggest <- function(address, results = 5, url_only = FALSE) {
   )
 
   # Add address
-  url = paste0(
+  url <- paste0(
     url,
     "&q=",
     address
   )
 
   # Add bbox containing the world
-  url = paste0(
+  url <- paste0(
     url,
     "&in=bbox:-180,-90,180,90"
   )
 
   # Add max results
-  url = paste0(
+  url <- paste0(
     url,
     "&limit=",
     results
   )
 
   # Return urls if chosen
-  if (url_only) return(url)
+  if (url_only) {
+    return(url)
+  }
 
   # Request and get content
   data <- .get_content(
     url = url
   )
-  if (length(data) == 0) return(NULL)
+  if (length(data) == 0) {
+    return(NULL)
+  }
 
   # Extract information
   suggestion <- .extract_suggestions(data)
@@ -81,18 +85,23 @@ autosuggest <- function(address, results = 5, url_only = FALSE) {
   ids <- .get_ids(data)
   count <- 0
   result <- data.table::rbindlist(
-    append(list(template),
-           lapply(data, function(con) {
-             count <<- count + 1
-             df <- jsonlite::fromJSON(con)
-             if (length(nrow(df$items)) == 0) return(NULL)
-             data.table::data.table(
-               id = ids[count],
-               rank = seq(1, nrow(df$items)),
-               suggestion = df$items$title,
-               type = df$items$resultType
-             )
-           })
-    ), fill = TRUE)
+    append(
+      list(template),
+      lapply(data, function(con) {
+        count <<- count + 1
+        df <- jsonlite::fromJSON(con)
+        if (length(nrow(df$items)) == 0) {
+          return(NULL)
+        }
+        data.table::data.table(
+          id = ids[count],
+          rank = seq(1, nrow(df$items)),
+          suggestion = df$items$title,
+          type = df$items$resultType
+        )
+      })
+    ),
+    fill = TRUE
+  )
   result
 }
diff --git a/R/checks.R b/R/checks.R
@@ -65,13 +65,14 @@
 }
 
 .check_input_rows <- function(x, y) {
-  if (nrow(x) != nrow(y))
+  if (nrow(x) != nrow(y)) {
     stop(
       sprintf(
         "'%s' must have the same number of rows as '%s'.",
         deparse(substitute(x)), deparse(substitute(y))
       )
     )
+  }
 }
 
 .check_bbox <- function(bbox) {
@@ -130,7 +131,7 @@
   modes <- c("fast", "short")
   if (!routing_mode %in% modes) {
     stop(
-        sprintf(
+      sprintf(
         "Routing mode '%s' not valid, must be in ('%s').",
         routing_mode,
         paste(modes, collapse = "', '")
@@ -153,7 +154,7 @@
   if (!(is.character(api_key) & api_key != "")) {
     stop(
       "Please provide an 'API key' for a HERE project.
-         Get your login here: https://developer.here.com/"
+      Get your login here: https://developer.here.com/"
     )
   }
 }

diff --git a/R/connection.R b/R/connection.R
@@ -72,7 +72,7 @@ connection <- function(origin, destination, datetime = Sys.time(),
   )
 
   # Add departure and arrival
-  url = paste0(
+  url <- paste0(
     url,
     "&origin=",
     coords_orig,
@@ -104,19 +104,23 @@ connection <- function(origin, destination, datetime = Sys.time(),
   }
 
   # Add route attributes
-  url = paste0(
+  url <- paste0(
     url,
     "&return=polyline,travelSummary"
   )
 
   # Return urls if chosen
-  if (url_only) return(url)
+  if (url_only) {
+    return(url)
+  }
 
   # Request and get content
   data <- .get_content(
     url = url
   )
-  if (length(data) == 0) return(NULL)
+  if (length(data) == 0) {
+    return(NULL)
+  }
 
   # Extract information
   routes <- .extract_connection_sections(data)
@@ -138,10 +142,14 @@ connection <- function(origin, destination, datetime = Sys.time(),
     routes <- .connection_summary(routes)
   }
 
+  # Bug of data.table and sf combination? Drops sfc class, when only one row...
+  routes <- as.data.frame(routes)
+  routes$geometry <- sf::st_sfc(routes$geometry, crs = 4326)
+
   # Create sf object
   return(
     sf::st_as_sf(
-      as.data.frame(routes),
+      routes,
       sf_column_name = "geometry",
       crs = 4326
     )
@@ -156,6 +164,7 @@ connection <- function(origin, destination, datetime = Sys.time(),
   template <- data.table::data.table(
     id = numeric(),
     rank = numeric(),
+    section = numeric(),
     departure = character(),
     origin = character(),
     arrival = character(),
@@ -170,13 +179,16 @@ connection <- function(origin, destination, datetime = Sys.time(),
     geometry = character()
   )
   routes <- data.table::rbindlist(
-    append(list(template),
+    append(
+      list(template),
       lapply(data, function(con) {
         count <<- count + 1
 
         # Parse JSON
         df <- jsonlite::fromJSON(con)
-        if (is.null(df$routes$sections)) {return(NULL)}
+        if (is.null(df$routes$sections)) {
+          return(NULL)
+        }
 
         # Connections
         rank <- 0
@@ -189,14 +201,19 @@ connection <- function(origin, destination, datetime = Sys.time(),
               rank <<- rank + 1
               data.table::data.table(
                 rank = rank,
+                section = seq_len(nrow(sec)),
                 departure = sec$departure$time,
-                origin = vapply(sec$departure$place$name,
-                                function(x) if (is.na(x)) "ORIG" else x,
-                                character(1)),
+                origin = vapply(
+                  sec$departure$place$name,
+                  function(x) if (is.na(x)) "ORIG" else x,
+                  character(1)
+                ),
                 arrival = sec$arrival$time,
-                destination = vapply(sec$arrival$place$name,
-                                     function(x) if (is.na(x)) "DEST" else x,
-                                     character(1)),
+                destination = vapply(
+                  sec$arrival$place$name,
+                  function(x) if (is.na(x)) "DEST" else x,
+                  character(1)
+                ),
                 mode = sec$transport$mode,
                 category = sec$transport$category,
                 vehicle = sec$transport$name,
@@ -206,13 +223,19 @@ connection <- function(origin, destination, datetime = Sys.time(),
                 duration = sec$travelSummary$duration,
                 geometry = sec$polyline
               )
-            }), fill = TRUE)
+            }),
+            fill = TRUE
+          )
         )
-      })), fill = TRUE
-    )
+      })
+    ),
+    fill = TRUE
+  )
 
   # Check success
-  if (nrow(routes) < 1) {return(NULL)}
+  if (nrow(routes) < 1) {
+    return(NULL)
+  }
 
   # Decode flexible polyline encoding to LINESTRING
   routes$geometry <- sf::st_geometry(
@@ -230,16 +253,15 @@ connection <- function(origin, destination, datetime = Sys.time(),
     departure = min(departure),
     origin = origin[2],
     arrival = max(arrival),
-    destination = destination[length(destination)-1],
+    destination = destination[length(destination) - 1],
     transfers = length(stats::na.exclude(vehicle)) - 1,
     modes = paste(stats::na.exclude(mode), collapse = ", "),
     categories = paste(stats::na.exclude(category), collapse = ", "),
     vehicles = paste(stats::na.exclude(vehicle), collapse = ", "),
     providers = paste(stats::na.exclude(provider), collapse = ", "),
     distance = sum(distance),
     duration = sum(duration),
-    geometry = sf::st_union(geometry)
+    geometry = suppressMessages(sf::st_union(geometry))
   ), by = list(id, rank)]
   return(summary)
 }
-
diff --git a/R/defunct.R b/R/defunct.R
@@ -79,7 +79,7 @@ NULL
 #' For \code{set_auth}, use \code{\link{set_key}}.
 #'
 #' @export
-set_auth <- function(app_id, app_code){
+set_auth <- function(app_id, app_code) {
   .Defunct(new = "set_key", package = "hereR")
 }
 
@@ -172,7 +172,7 @@ set_proxy <- function(proxy, proxyuserpwd) {
 #' @keywords internal
 NULL
 
-#' #' @rdname hereR-defunct
+#' @rdname hereR-defunct
 #' @section \code{unset_proxy}:
 #' For \code{unset_proxy}, configure a global proxy for R in '~/.Renviron' instead.
 #'