add dodgr_insert_vertex fn; closes #40

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: dodgr
 Title: Distances on Directed Graphs
-Version: 0.2.5.041
+Version: 0.2.5.042
 Authors@R: c(
     person("Mark", "Padgham", email="mark.padgham@email.com", role=c("aut", "cre")),
     person("Andreas", "Petutschnig", role="aut"),

NAMESPACE

@@ -19,6 +19,7 @@ export(dodgr_flows_disperse)
 export(dodgr_flows_si)
 export(dodgr_full_cycles)
 export(dodgr_fundamental_cycles)
+export(dodgr_insert_vertex)
 export(dodgr_isochrones)
 export(dodgr_isodists)
 export(dodgr_isoverts)

NEWS.md

@@ -7,6 +7,7 @@ Major changes:
 - `merge_directed_flows` renamed to `merge_directed_graph`, with added option
   of specifying columns to merge.
 - Added new `pairwise` parameter to `dodgr_distances`; see issue #127
+- Added new function `dodgr_insert_vertex` to add new vertices to graph; see #40
 - Removed "radix" heap option
 
 Minor changes:

R/graph-functions.R

@@ -331,3 +331,107 @@ dodgr_sample <- function (graph, nverts = 1000)
 
     return (graph)
 }
+
+#' dodgr_insert_vertex
+#'
+#' Insert a new node or vertex into a network
+#'
+#' @param v1 Vertex defining start of graph edge along which new vertex is to be
+#' inserted
+#' @param v2 Vertex defining end of graph edge along which new vertex is to be
+#' inserted (order of `v1` and `v2` is not important).
+#' @param x The `x`-coordinate of new vertex. If not specified, vertex is
+#' created half-way between `v1` and `v2`.
+#' @param y The `y`-coordinate of new vertex. If not specified, vertex is
+#' created half-way between `v1` and `v2`.
+#' @return A modifed graph with specified edge between defined start and end
+#' vertices split into two edges either side of new vertex.
+#' @inheritParams dodgr_vertices
+#'
+#' @export
+#' @examples
+#' graph <- weight_streetnet (hampi)
+#' e1 <- sample (nrow (graph), 1)
+#' v1 <- graph$from_id [e1]
+#' v2 <- graph$to_id [e1]
+#' # insert new vertex in the middle of that randomly-selected edge:
+#' graph2 <- dodgr_insert_vertex (graph, v1, v2)
+#' nrow (graph); nrow (graph2) # new edges added to graph2
+dodgr_insert_vertex <- function (graph, v1, v2, x = NULL, y = NULL)
+{
+    graph_t <- tbl_to_df (graph)
+    gr_cols <- dodgr_graph_cols (graph_t)
+    index12 <- which (graph [[gr_cols$from]] == v1 & graph [[gr_cols$to]] == v2)
+    index21 <- which (graph [[gr_cols$from]] == v2 & graph [[gr_cols$to]] == v1)
+    if (length (index12) == 0 & length (index21) == 0)
+        stop ("Nominated vertices do not define any edges in graph")
+    if ((!is.null (x) & is.null (y)) | (is.null (x) & !is.null (y)))
+        stop ("Either both x and y must be NULL, or both must be specified")
+
+
+    if (length (index12) == 1) {
+        graph <- insert_one_edge (graph, index12, x, y, gr_cols)
+        index21 <- which (graph [[gr_cols$from]] == v2 &
+                          graph [[gr_cols$to]] == v1)
+    }
+    if (length (index21) == 1) {
+        graph <- insert_one_edge (graph, index21, x, y, gr_cols)
+    }
+
+    attr (graph, "hash") <- digest::digest (graph [[gr_cols$edge_id]])
+
+    return (graph)
+}
+
+insert_one_edge <- function (graph, index, x, y, gr_cols)
+{
+    if (is.null (x) & is.null (y)) {
+        x <- (graph [[gr_cols$xfr]] [index] +
+              graph [[gr_cols$xto]] [index]) / 2
+        y <- (graph [[gr_cols$yfr]] [index] +
+              graph [[gr_cols$yto]] [index]) / 2
+    }
+    expand_index <- c (1:index, index, (index + 1):nrow (graph))
+    graph <- graph [expand_index, ]
+    graph [index, gr_cols$xto] <- x
+    graph [index, gr_cols$yto] <- y
+    graph [index + 1, gr_cols$xfr] <- x
+    graph [index + 1, gr_cols$yfr] <- y
+
+    xy1 <- c (x = graph [[gr_cols$xfr]] [index],
+              y = graph [[gr_cols$yfr]] [index])
+    xy2 <- c (x = graph [[gr_cols$xto]] [index + 1],
+              y = graph [[gr_cols$yto]] [index + 1])
+    if (is_graph_spatial (graph)) {
+        #requireNamespace ("geodist")
+        d1 <- geodist::geodist (xy1, c (x = x, y = y))
+        d2 <- geodist::geodist (xy2, c (x = x, y = y))
+    } else {
+        d1 <- sqrt ((xy1 [1] - x) ^ 2 + (xy1 [2] - y) ^ 2)
+        d2 <- sqrt ((x - xy2 [1]) ^ 2 + (y - xy2 [2]) ^ 2)
+    }
+    wt <- graph [index, gr_cols$d_weighted] /
+        graph [index, gr_cols$d]
+    if (!is.na (gr_cols$time)) {
+        time_scale <- graph [index, gr_cols$time] /
+            graph [index, gr_cols$d]
+        time_wt <- graph [index, gr_cols$time_weighted] /
+            graph [index, gr_cols$time]
+    }
+    graph [index, gr_cols$d] <- d1
+    graph [index, gr_cols$d_weighted] <- d1 * wt
+    graph [index + 1, gr_cols$d] <- d2
+    graph [index + 1, gr_cols$d_weighted] <- d2 * wt
+
+    if (!is.na (gr_cols$time)) {
+        graph [index, gr_cols$time] <- graph [index, gr_cols$d] *
+            time_scale
+        graph [index, gr_cols$time_weighted] <-
+            graph [index, gr_cols$time] * time_wt
+    }
+
+    graph$edge_id [index] <- paste0 (graph$edge_id [index], "_a")
+    graph$edge_id [index + 1] <- paste0 (graph$edge_id [index + 1], "_b")
+
+    return (graph)
+}

_pkgdown.yml

@@ -49,6 +49,7 @@ reference:
     - dodgr_flowmap
     - dodgr_full_cycles
     - dodgr_fundamental_cycles
+    - dodgr_insert_vertex
     - dodgr_sample
     - dodgr_sflines_to_poly
     - dodgr_vertices

codemeta.json

@@ -10,7 +10,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.5.41",
+  "version": "0.2.5.42",
   "programmingLanguage": {
     "@type": "ComputerLanguage",
     "name": "R",
@@ -412,5 +412,5 @@
     }
   ],
   "relatedLink": "https://CRAN.R-project.org/package=dodgr",
-  "fileSize": "388.075KB"
+  "fileSize": "387.858KB"
 }

tests/testthat/test-graph-fns.R

@@ -38,6 +38,16 @@ test_that("sample graph", {
     expect_true (max (graphs$edge_id) <= nrow (graph))
 })
 
+test_that ("insert_vertex", {
+    graph <- weight_streetnet (hampi)
+    e1 <- 2256
+    v1 <- graph$from_id [e1]
+    v2 <- graph$to_id [e1]
+    expect_silent (graph2 <- dodgr_insert_vertex (graph, v1 = v1, v2 = v2))
+    # graph should have two more rows added:
+    expect_equal (nrow (graph2) - 2, nrow (graph))
+})
+
 test_that("components", {
     graph <- weight_streetnet (hampi)
     comp <- graph$component