From e67151782736fec0bc321314719d1036bdbfd83a Mon Sep 17 00:00:00 2001 From: mpadge Date: Thu, 11 Aug 2022 10:39:35 +0200 Subject: [PATCH] separate pre-process-xy fn for #103 --- DESCRIPTION | 2 +- R/match-points.R | 79 +++++++++++++++++++----------------------------- codemeta.json | 2 +- 3 files changed, 33 insertions(+), 50 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index ae613864c..45a0f7760 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: dodgr Title: Distances on Directed Graphs -Version: 0.2.14.085 +Version: 0.2.14.086 Authors@R: c( person("Mark", "Padgham", , "mark.padgham@email.com", role = c("aut", "cre")), person("Andreas", "Petutschnig", role = "aut"), diff --git a/R/match-points.R b/R/match-points.R index 3ac1c8c3d..e2332ceba 100644 --- a/R/match-points.R +++ b/R/match-points.R @@ -40,14 +40,6 @@ match_pts_to_verts <- function (verts, xy, connected = FALSE) { ) verts <- dodgr_vertices (verts) } - 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") - } - } indx <- seq (nrow (verts)) if (connected) { @@ -57,6 +49,35 @@ match_pts_to_verts <- function (verts, xy, connected = FALSE) { xyi <- find_xy_col_simple (verts) verts <- data.frame (x = verts [indx, xyi [1]], y = verts [indx, xyi [2]]) + + xy <- pre_process_xy (xy) + + # rcpp_points_index is 0-indexed, so ... + indx [rcpp_points_index_par (verts, xy) + 1L] +} + +#' match_points_to_verts +#' +#' Alias for \link{match_pts_to_verts} +#' @inherit match_pts_to_verts +#' @family misc +#' @export +match_points_to_verts <- function (verts, xy, connected = FALSE) { + + match_pts_to_verts (verts, xy, connected = connected) +} + +pre_process_xy <- function (xy) { + + 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 (xy, "tbl")) { xy <- data.frame (xy) } @@ -76,19 +97,7 @@ match_pts_to_verts <- function (verts, xy, connected = FALSE) { xy <- data.frame (x = xy [, xyi [1]], y = xy [, xyi [2]]) } - # rcpp_points_index is 0-indexed, so ... - indx [rcpp_points_index_par (verts, xy) + 1L] -} - -#' match_points_to_verts -#' -#' Alias for \link{match_pts_to_verts} -#' @inherit match_pts_to_verts -#' @family misc -#' @export -match_points_to_verts <- function (verts, xy, connected = FALSE) { - - match_pts_to_verts (verts, xy, connected = connected) + return (xy) } #' match_pts_to_graph @@ -122,15 +131,6 @@ match_points_to_verts <- function (verts, xy, connected = FALSE) { #' 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.") } @@ -139,24 +139,7 @@ match_pts_to_graph <- function (graph, xy, connected = FALSE) { 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]]) - } + xy <- pre_process_xy (xy) gr_cols <- dodgr_graph_cols (graph) gr_cols <- unlist (gr_cols [which (!is.na (gr_cols))]) diff --git a/codemeta.json b/codemeta.json index 5409e7bd4..1c32b48d7 100644 --- a/codemeta.json +++ b/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.085", + "version": "0.2.14.086", "programmingLanguage": { "@type": "ComputerLanguage", "name": "R",