feat: add osrmNearest()

NAMESPACE

@@ -3,6 +3,7 @@
 export(osrmIsochrone)
 export(osrmIsodistance)
 export(osrmIsometric)
+export(osrmNearest)
 export(osrmRoute)
 export(osrmTable)
 export(osrmTrip)

R/osrmNearest.R

@@ -0,0 +1,85 @@
+#' @name osrmNearest
+#' @title Get the Nearest Point on the Street Network 
+#' @description This function interfaces with the \emph{nearest} OSRM 
+#' service.\cr
+#' @param loc a point to snap to the street network. \code{loc} can be: \itemize{
+#'   \item a vector of coordinates (longitude and latitude, WGS 84), 
+#'   \item a data.frame of longitudes and latitudes (WGS 84),
+#'   \item a matrix of longitudes and latitudes (WGS 84),
+#'   \item an sfc object of type POINT,
+#'   \item an sf object of type POINT.
+#'}
+#' If \code{src} is a data.frame, a matrix, an sfc object or an sf object then 
+#' only the first row or element is considered.
+#' @param exclude pass an optional "exclude" request option to the OSRM API. 
+#' @param osrm.server the base URL of the routing server.
+#' @param osrm.profile the routing profile to use, e.g. "car", "bike" or "foot".
+#' @return
+#' The output of this function is an sf POINT of the point on the street 
+#' network.\cr
+#' It contains 2 fields: \itemize{
+#'   \item id, the point identifierv
+#'   \item distance, the distance in meters to the supplied input point.
+#'   }
+#' @importFrom sf st_as_sfc st_crs st_geometry st_sf st_as_sf st_transform
+#' @examples
+#' \dontrun{
+#' library(sf)
+#' apotheke.sf <- st_read(system.file("gpkg/apotheke.gpkg", package = "osrm"),
+#'                        quiet = TRUE)
+#' pt <- osrmNearest(apotheke.sf[56, ])
+#' pt$distance
+#' }
+#' @export
+osrmNearest <- function( 
+    loc, 
+    exclude,
+    osrm.server = getOption("osrm.server"),
+    osrm.profile = getOption("osrm.profile")){
+
+  opt <- options(error = NULL)
+  on.exit(options(opt), add=TRUE)
+
+  url <- base_url(osrm.server, osrm.profile, "nearest")
+
+  # from src to dst via x, y, z... (data.frame or sf input)
+  loc <- input_route(x = loc, single = TRUE, id = "loc")
+  id <- loc$id
+  oprj <- loc$oprj
+  coords <- paste0(loc$lon, ",", loc$lat)
+
+  url <- paste0(url, coords, "?number=1&generate_hints=false")
+
+  # adding exclude parameter
+  if (!missing(exclude)) {url <- paste0(url, "&exclude=", exclude)}
+
+  e <- try({
+    req_handle <- curl::new_handle(verbose = FALSE)
+    curl::handle_setopt(req_handle, useragent = "osrm_R_package")
+    r <- curl::curl_fetch_memory(utils::URLencode(url), handle = req_handle)
+  }, silent = TRUE)
+  if (inherits(e,"try-error")){ 
+    stop(e, call. = FALSE)
+  }
+
+  # test result validity
+  test_http_error(r)
+  res <- RcppSimdJson::fparse(rawToChar(r$content))
+
+  # Coordinates of the point
+  r <-   res$waypoints$location[[1]]
+  # Convert to POINT
+  rcoords <- paste0(r, collapse = " ")
+  rosf <- st_sf(id = id,
+                distance = round(res$waypoints$distance, 1),
+                geometry = st_as_sfc(paste0("POINT(",rcoords,")")), 
+                crs = 4326, 
+                row.names = id)
+  # prj
+  if (!is.na(oprj)){
+    rosf <- st_transform(rosf, oprj)
+  }
+
+  return(rosf)
+
+}

R/package.R

@@ -16,13 +16,16 @@
 #' shortest travel geometry between multiple unordered points. This function 
 #' interfaces the \emph{trip} OSRM service. Use this function to resolve the 
 #' travelling salesman problem.}
+#' \item{\code{\link{osrmNearest}}: Build and send an OSRM API query to get the 
+#' nearest point on the street network. This function interfaces the 
+#' \emph{nearest} OSRM service.}
 #' \item{\code{\link{osrmIsochrone}}: This function computes areas that are 
 #' reachable within a given time span from a point and returns the reachable 
 #' regions as polygons. These areas of equal travel time are called isochrones.}
 #' \item{\code{\link{osrmIsodistance}}: This function computes areas that are 
 #' reachable within a given road distance from a point and returns the reachable 
 #' regions as polygons. These areas of equal travel distance are called 
-#' isodistances}
+#' isodistances.}
 #' }
 #' 
 #' 

README.Rmd

@@ -35,6 +35,7 @@ You can run your own instance of OSRM following guidelines provided [here](https
 - `osrmTable()` uses the *table* service to query time/distance matrices,
 - `osrmRoute()` uses the *route* service to query routes,
 - `osrmTrip()` uses the *trip* service to query trips,
+- `osrmNearest()` uses the *nearest* service to query the nearest point on the street network, 
 - `osrmIsochrone()` and `osrmIsodistance()` use multiple `osrmTable()` calls to create isochrones or isodistances polygons.
 
 ## Demo
@@ -146,6 +147,22 @@ text(st_coordinates(pharmacy[1:5,]), labels = row.names(pharmacy[1:5,]),
 
 ![](trip.png)
 
+* `osrmNearest()` gives access to the *nearest* OSRM service. It returns the nearest point on the street network from any point. Here we will get the nearest point on the network from a couple of coordinates. 
+
+``` r
+pt_not_on_street_network <- c(13.40, 52.47)
+(pt_on_street_network <- osrmNearest(loc = pt_not_on_street_network))
+```
+
+    ## Simple feature collection with 1 feature and 2 fields
+    ## Geometry type: POINT
+    ## Dimension:     XY
+    ## Bounding box:  xmin: 13.39671 ymin: 52.46661 xmax: 13.39671 ymax: 52.46661
+    ## Geodetic CRS:  WGS 84
+    ##      id distance                  geometry
+    ## loc loc      439 POINT (13.39671 52.46661)
+
+The distance from the input point to the nearest point on the street network is of 439 meters
 
 * `osrmIsochrone()` computes areas that are reachable within a given time span from a point and returns the reachable regions as polygons. These areas of equal travel time are called isochrones. Here we compute the isochrones from a specific point defined by its longitude and latitude. 
 

README.md

@@ -44,6 +44,8 @@ service**:
   matrices,
 - `osrmRoute()` uses the *route* service to query routes,
 - `osrmTrip()` uses the *trip* service to query trips,
+- `osrmNearest()` uses the *nearest* service to query the nearest point
+  on the street network,
 - `osrmIsochrone()` and `osrmIsodistance()` use multiple `osrmTable()`
   calls to create isochrones or isodistances polygons.
 
@@ -169,6 +171,26 @@ text(st_coordinates(pharmacy[1:5,]), labels = row.names(pharmacy[1:5,]),
 
 ![](trip.png)
 
+- `osrmNearest()` gives access to the *nearest* OSRM service. It returns
+  the nearest point on the street network from any point. Here we will
+  get the nearest point on the network from a couple of coordinates.
+
+``` r
+pt_not_on_street_network <- c(13.40, 52.47)
+(pt_on_street_network <- osrmNearest(loc = pt_not_on_street_network))
+```
+
+    ## Simple feature collection with 1 feature and 2 fields
+    ## Geometry type: POINT
+    ## Dimension:     XY
+    ## Bounding box:  xmin: 13.39671 ymin: 52.46661 xmax: 13.39671 ymax: 52.46661
+    ## Geodetic CRS:  WGS 84
+    ##      id distance                  geometry
+    ## loc loc      439 POINT (13.39671 52.46661)
+
+The distance from the input point to the nearest point on the street
+network is of 439 meters
+
 - `osrmIsochrone()` computes areas that are reachable within a given
   time span from a point and returns the reachable regions as polygons.
   These areas of equal travel time are called isochrones. Here we

inst/tinytest/test_osrmNearest.R

@@ -0,0 +1,71 @@
+if(demo_server){
+  ######################## DEMO car ###########################
+  options(osrm.server = "https://routing.openstreetmap.de/", 
+          osrm.profile = "car")
+  wait()
+  r <- osrmNearest(loc = x_sf[1, ])
+  expect_true(inherits(r, "sf"))
+  expect_identical(st_crs(r), st_crs(x_sf))
+  expect_true(nrow(r) == 1)
+  expect_identical(colnames(r), c("id", "distance", "geometry"))
+  expect_true(st_geometry_type(r) == "POINT")
+
+  ################# DEMO BIKE #####################
+  options(osrm.server = "https://routing.openstreetmap.de/", osrm.profile = "bike")
+  wait()
+  r <- osrmNearest(loc = x_sf[1, ])
+  expect_true(inherits(r, "sf"))
+  expect_identical(st_crs(r), st_crs(x_sf))
+  expect_true(nrow(r) == 1)
+  expect_identical(colnames(r), c("id", "distance", "geometry"))
+  expect_true(st_geometry_type(r) == "POINT")
+
+  ############## DEMO FOOT #################"""""
+  options(osrm.server = "https://routing.openstreetmap.de/", osrm.profile = "foot")
+  wait()
+  r <- osrmNearest(loc = x_sf[1, ])
+  expect_true(inherits(r, "sf"))
+  expect_identical(st_crs(r), st_crs(x_sf))
+  expect_true(nrow(r) == 1)
+  expect_identical(colnames(r), c("id", "distance", "geometry"))
+  expect_true(st_geometry_type(r) == "POINT")
+
+  ############# server param ##################""
+  wait()
+  r <-  osrmNearest(loc = x_sf[1, ], 
+                    osrm.server = "https://router.project-osrm.org/", 
+                    osrm.profile = "driving")
+  expect_true(inherits(r, "sf"))
+
+  # server error
+  expect_error(osrmNearest(loc = x_sf[1, ], 
+                           osrm.server = "https://router.project-osrm.orgS/", 
+                           osrm.profile = "driving"))
+  expect_error(osrmNearest(loc = x_sf[1, ], 
+                           exclude = "motorway",
+                           osrm.server = "https://router.project-osrm.org/", 
+                           osrm.profile = "driving"))
+}
+
+
+
+# ############## ONLY LOCAL ############################################
+if(local_server){
+  options(osrm.server = "http://0.0.0.0:5000/", osrm.profile = "test")
+  r <- osrmNearest(loc = x_sf[1, ])
+  expect_true(inherits(r, "sf"))
+  expect_identical(st_crs(r), st_crs(x_sf))
+  expect_true(nrow(r) == 1)
+  expect_identical(colnames(r), c("id", "distance", "geometry"))
+  expect_true(st_geometry_type(r) == "POINT")
+
+  # server error
+  expect_error(osrmNearest(loc = x_sf[1, ], 
+                           osrm.server = "http://0.0.0.0:5100/", 
+                           osrm.profile = "driving"))
+  expect_error(osrmNearest(loc = x_sf[1, ], 
+                           exclude = "autoroute",
+                           osrm.server = "http://0.0.0.0:5000/", 
+                           osrm.profile = "driving"))
+}
+