add new match_pts_to_graph fn for #103

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: dodgr
 Title: Distances on Directed Graphs
-Version: 0.2.14.084
+Version: 0.2.14.085
 Authors@R: c(
     person("Mark", "Padgham", , "[email protected]", role = c("aut", "cre")),
     person("Andreas", "Petutschnig", role = "aut"),

NAMESPACE

@@ -42,7 +42,9 @@ export(dodgr_vertices)
 export(estimate_centrality_threshold)
 export(estimate_centrality_time)
 export(igraph_to_dodgr)
+export(match_points_to_graph)
 export(match_points_to_verts)
+export(match_pts_to_graph)
 export(match_pts_to_verts)
 export(merge_directed_graph)
 export(weight_railway)

NEWS.md

@@ -3,6 +3,7 @@
 ## Breaking changes:
 
 - `match_pts_to_graph()` renamed to `match_pts_to_verts()`
+- New `match_pts_to_graph()` function matches to graph edges, using nearest perpendicular intersection (issue #103)
 
 ## Major changes:
 

R/match-points.R

@@ -90,3 +90,90 @@ match_points_to_verts <- function (verts, xy, connected = FALSE) {
 
     match_pts_to_verts (verts, xy, connected = connected)
 }
+
+#' match_pts_to_graph
+#'
+#' Match spatial points to the edges of a spatial graph, through finding the
+#' edge with the closest perpendicular intersection. NOTE: Intersections are
+#' calculated geometrically, and presume planar geometry. It is up to users of
+#' projected geometrical data, such as those within a `dodgr_streetnet` object,
+#' to ensure that either: (i) Data span an sufficiently small area that errors
+#' from presuming planar geometry may be ignored; or (ii) Data are re-projected
+#' to an equivalent planar geometry prior to calling this routine.
+#'
+#' @param graph A `dodgr` graph with spatial coordinates, such as a
+#' `dodgr_streetnet` object.
+#' @inheritParams match_pts_to_verts
+#'
+#' @return A vector index matching the `xy` coordinates to nearest edges. For
+#' bi-directional edges, only one match is returned, and it is up to the user to
+#' identify and suitably process matching edge pairs.
+#' @family misc
+#' @export
+#' @examples
+#' net <- weight_streetnet (hampi, wt_profile = "foot")
+#' # Then generate some random points to match to graph
+#' npts <- 10
+#' xy <- data.frame (
+#'     x = min (verts$x) + runif (npts) * diff (range (verts$x)),
+#'     y = min (verts$y) + runif (npts) * diff (range (verts$y))
+#' )
+#' edges <- match_pts_to_graph (graph, xy)
+#' graph [edges, ] # The edges of the graph closest to `xy`
+match_pts_to_graph <- function (graph, xy, connected = FALSE) {
+
+    if (!(is.matrix (xy) || is.data.frame (xy))) {
+        stop ("xy must be a matrix or data.frame")
+    }
+    if (!is (xy, "sf")) {
+        if (ncol (xy) != 2) {
+            stop ("xy must have only two columns")
+        }
+    }
+
+    if (!is_graph_spatial (graph)) {
+        stop ("Points may only be matched to spatial graphs.")
+    }
+
+    if (connected) {
+        graph <- graph [which (graph$component == 1), ]
+    }
+
+    if (is (xy, "tbl")) {
+        xy <- data.frame (xy)
+    }
+    if (is (xy, "sf")) {
+        if (!"geometry" %in% names (xy)) {
+            stop ("xy has no sf geometry column")
+        } # nocov
+        if (!is (xy$geometry, "sfc_POINT")) {
+            stop ("xy$geometry must be a collection of sfc_POINT objects")
+        }
+        xy <- unlist (lapply (xy$geometry, as.numeric)) %>%
+            matrix (nrow = 2) %>%
+            t ()
+        xy <- data.frame (x = xy [, 1], y = xy [, 2])
+    } else {
+        xyi <- find_xy_col_simple (xy)
+        xy <- data.frame (x = xy [, xyi [1]], y = xy [, xyi [2]])
+    }
+
+    gr_cols <- dodgr_graph_cols (graph)
+    gr_cols <- unlist (gr_cols [which (!is.na (gr_cols))])
+    graph <- graph [, gr_cols]
+    names (graph) <- names (gr_cols)
+
+    # rcpp_points_index is 0-indexed, so ...
+    rcpp_points_to_edges_par (graph, xy) + 1L
+}
+
+#' match_points_to_graph
+#'
+#' Alias for \link{match_pts_to_graph}
+#' @inherit match_pts_to_graph
+#' @family misc
+#' @export
+match_points_to_graph <- function (graph, xy, connected = FALSE) {
+
+    match_pts_to_graph (graph, xy, connected = connected)
+}

codemeta.json

@@ -7,7 +7,7 @@
   "codeRepository": "https://github.com/ATFutures/dodgr",
   "issueTracker": "https://github.com/ATFutures/dodgr/issues",
   "license": "https://spdx.org/licenses/GPL-3.0",
-  "version": "0.2.14.084",
+  "version": "0.2.14.085",
   "programmingLanguage": {
     "@type": "ComputerLanguage",
     "name": "R",