Implement segmentation as part of the package

R/corridor.R

@@ -129,25 +129,6 @@ split_aoi <- function(bbox, river) {
   }
 }
 
-#' Split a geometry along a (multi)linestring.
-#'
-#' @param geometry Geometry to split
-#' @param line Dividing (multi)linestring
-#' @param boundary Whether to return the split boundary instead of the regions
-#'
-#' @return A simple feature object
-split <- function(geometry, line, boundary = FALSE) {
-  regions <- lwgeom::st_split(geometry, line) |>
-    sf::st_collection_extract()
-  if (!boundary) {
-    return(regions)
-  } else {
-    boundaries <- sf::st_boundary(regions)
-    split_boundary <- sf::st_difference(boundaries, line)
-    return(split_boundary)
-  }
-}
-
 #' Identify the initial edges of the river corridor
 #'
 #' These are defined by splitting the initial corridor boundary into the
@@ -216,15 +197,3 @@ cap_corridor <- function(edges, method = "direct", network = NULL) {
   }
   as_polygon(c(edges, cap_edge_1, cap_edge_2))
 }
-
-as_linestring <- function(points) {
-  points_union <- sf::st_union(points)
-  sf::st_cast(points_union, "LINESTRING")
-}
-
-as_polygon <- function(lines) {
-  lines_union <- sf::st_union(lines)
-  sf::st_line_merge(lines_union) |>
-    sf::st_polygonize() |>
-    sf::st_collection_extract()
-}

R/delineate.R

@@ -13,7 +13,7 @@
 #'   the available methods
 #' @param angle_threshold Only network edges forming angles above this threshold
 #'   (in degrees) are considered when forming segment edges. See
-#'  `[get_segments()]`  and [strokes()]. Only used if `segments` is TRUE.
+#'  [get_segments()]  and [rcoins::stroke()]. Only used if `segments` is TRUE.
 #' @param segments Whether to carry out the corridor segmentation
 #' @param riverspace Whether to carry out the riverspace delineation
 #'

R/network.R

@@ -307,3 +307,21 @@ filter_network <- function(network, target) {
     tidygraph::activate("nodes") |>
     tidygraph::filter(sfnetworks::node_intersects(target))
 }
+
+#' Identify network edges that are intersecting a geometry
+#'
+#' @param network A spatial network object
+#' @param geometry A simple feature geometry
+#' @param index Whether to return the indices of the matchin edges or the
+#'   geometries
+#'
+#' @return Indices or geometries of the edges intersecting the given geometry
+get_intersecting_edges <- function(network, geometry, index = FALSE) {
+  edges <- sf::st_as_sf(network, "edges")
+  intersects <- sf::st_intersects(edges, geometry, sparse = FALSE)
+  if (index) {
+    return(which(intersects))
+  } else {
+    return(edges[intersects, ])
+  }
+}

R/segments.R

@@ -16,7 +16,7 @@ get_segments <- function(corridor, network, river_centerline,
                          angle_threshold = 90) {
 
   # Find river crossings in the network and build continuous strokes from them
-  crossings <- get_intersecting_edges(network, river_centerline)
+  crossings <- get_intersecting_edges(network, river_centerline, index = TRUE)
   crossing_strokes <- rcoins::stroke(network, from_edge = crossings,
                                      angle_threshold = angle_threshold)
 
@@ -31,17 +31,6 @@ get_segments <- function(corridor, network, river_centerline,
   refine_segments(blocks, river_centerline, corridor)
 }
 
-#' Identify network edges that are intersecting a geometry
-#'
-#' @param network A spatial network object
-#' @param geometry A simple feature geometry
-#'
-#' @return Indices of the edges intersecting the geometry as a vector
-get_intersecting_edges <- function(network, geometry) {
-  edges <- sf::st_as_sf(network, "edges")
-  which(sf::st_intersects(edges, geometry, sparse = FALSE))
-}
-
 #' Clip lines to the extent of the corridor, and filter valid segment edges
 #'
 #' Lines that intersect the river only once and that cross the corridor from
@@ -85,7 +74,7 @@ clip_and_filter <- function(lines, corridor, river_centerline) {
   filter_clusters(lines_valid, river_centerline)
 }
 
-#' Cluster the river crossings and select the shortest crossing per cluster.
+#' Cluster the river crossings and select the shortest crossing per cluster
 #'
 #' Create groups of edges that are crossing the river in nearby locations,
 #' using a density-based clustering method (DBSCAN). This is to make sure that
@@ -220,30 +209,3 @@ merge_block <- function(targets, block, method = "longest-intersection") {
   others <- targets[!seq_along(targets) %in% index_to_merge]
   return(c(others, merged))
 }
-
-#' @noRd
-find_smallest <- function(geometry) {
-  area <- sf::st_area(geometry)
-  return(which.min(area))
-}
-
-#' @noRd
-find_adjacent <- function(geometry, target) {
-  index_neighbour <- find_intersects(geometry, target)
-  intersections <- sf::st_intersection(geometry[index_neighbour], target)
-  is_adjacent_intersections <- sf::st_is(intersections,
-                                         c("MULTILINESTRING", "LINESTRING"))
-  return(index_neighbour[is_adjacent_intersections])
-}
-
-#' @noRd
-find_longest <- function(geometry) {
-  length <- sf::st_length(geometry)
-  return(which.max(length))
-}
-
-#' @noRd
-find_intersects <- function(geometry, target) {
-  instersects <- sf::st_intersects(geometry, target, sparse = FALSE)
-  return(which(instersects))
-}

R/sf.R

@@ -0,0 +1,59 @@
+#' @noRd
+as_linestring <- function(points) {
+  points_union <- sf::st_union(points)
+  sf::st_cast(points_union, "LINESTRING")
+}
+
+#' @noRd
+as_polygon <- function(lines) {
+  lines_union <- sf::st_union(lines)
+  sf::st_line_merge(lines_union) |>
+    sf::st_polygonize() |>
+    sf::st_collection_extract()
+}
+
+#' @noRd
+find_smallest <- function(geometry) {
+  area <- sf::st_area(geometry)
+  return(which.min(area))
+}
+
+#' @noRd
+find_adjacent <- function(geometry, target) {
+  index_neighbour <- find_intersects(geometry, target)
+  intersections <- sf::st_intersection(geometry[index_neighbour], target)
+  is_adjacent_intersections <- sf::st_is(intersections,
+                                         c("MULTILINESTRING", "LINESTRING"))
+  return(index_neighbour[is_adjacent_intersections])
+}
+
+#' @noRd
+find_longest <- function(geometry) {
+  length <- sf::st_length(geometry)
+  return(which.max(length))
+}
+
+#' @noRd
+find_intersects <- function(geometry, target) {
+  instersects <- sf::st_intersects(geometry, target, sparse = FALSE)
+  return(which(instersects))
+}
+
+#' Split a geometry along a (multi)linestring.
+#'
+#' @param geometry Geometry to split
+#' @param line Dividing (multi)linestring
+#' @param boundary Whether to return the split boundary instead of the regions
+#'
+#' @return A simple feature object
+split <- function(geometry, line, boundary = FALSE) {
+  regions <- lwgeom::st_split(geometry, line) |>
+    sf::st_collection_extract()
+  if (!boundary) {
+    return(regions)
+  } else {
+    boundaries <- sf::st_boundary(regions)
+    split_boundary <- sf::st_difference(boundaries, line)
+    return(split_boundary)
+  }
+}

tests/testthat/test-corridor.R

@@ -65,24 +65,6 @@ test_that("Splitting an AoI by a river works with real data", {
   expect_equal(length(aoi_split), 2)
 })
 
-test_that("Splitting a geometry by a complex line returns more regions", {
-  line <- sf::st_sfc(c(sf::st_linestring(cbind(c(-2, 2), c(0, 0))),
-                       sf::st_linestring(cbind(c(-0.5, 0, 0.5), c(0, 0.5, 0)))))
-  geometry <- sf::st_sfc(sf::st_polygon(list(cbind(c(-1, -1, 1, 1, -1),
-                                                   c(-1, 1, 1, -1, -1)))))
-  regions <- split(geometry, line)
-  expect_equal(length(regions), 3)
-})
-
-test_that("Splitting a geometry by a complex line still returns two edges", {
-  line <- sf::st_sfc(c(sf::st_linestring(cbind(c(-2, 2), c(0, 0))),
-                       sf::st_linestring(cbind(c(-0.5, 0, 0.5), c(0, 0.5, 0)))))
-  geometry <- sf::st_sfc(sf::st_polygon(list(cbind(c(-1, -1, 1, 1, -1),
-                                                   c(-1, 1, 1, -1, -1)))))
-  edges <- split(geometry, line, boundary = TRUE)
-  expect_equal(length(edges), 2)
-})
-
 test_that("Initial edges are identified if corridor exceeds AoI", {
   #        ____________
   #       |            |

tests/testthat/test-segments.R

@@ -1,3 +1,5 @@
+river <- sf::st_sfc(sf::st_linestring(cbind(c(-6, 6), c(0, 0))))
+
 test_that("Candidate segments boundaries are properly grouped and filtered", {
   e1 <- sf::st_linestring(cbind(c(-3, -3), c(-1, 1)))  # group 1 <--
   e2 <- sf::st_linestring(cbind(c(-3.1, -2.9), c(-1, 1)))  # group 1
@@ -35,7 +37,7 @@ test_that("Candidate segments are properly refined", {
   actual_longest_intersection <- merge_blocks(blocks, to_merge,
                                               "longest-intersection")
   # p2 and p4 are each others' smallest neighbours
-  expected_smallest <- sf::st_sfc(p1, p6, p5, p6, sf::st_union(p2, p4))
+  expected_smallest <- sf::st_sfc(p1, p3, p5, p6, sf::st_union(p2, p4))
   actual_smallest <- merge_blocks(blocks, to_merge, "smallest")
   equals_longest_intersection <- sf::st_equals(actual_longest_intersection,
                                                expected_longest_intersection,
@@ -80,8 +82,10 @@ test_that("Refinement works with equivalent options for merging", {
                                   sf::st_union(p2, p3), sf::st_union(p4, p5))
   actual_smallest <- merge_blocks(blocks, to_merge, "smallest")
   equals_longest_intersection <- sf::st_equals(actual_longest_intersection,
-                                               expected, sparse = FALSE)
-  equals_smallest <- sf::st_equals(actual_smallest, expected, sparse = FALSE)
+                                               expected_longest_intersection,
+                                               sparse = FALSE)
+  equals_smallest <- sf::st_equals(actual_smallest, expected_smallest,
+                                   sparse = FALSE)
   expect_true(all(sapply(seq_len(length(expected_longest_intersection)),
                          \(x) equals_longest_intersection[x, x])))
   expect_true(all(sapply(seq_len(length(expected_smallest)),

tests/testthat/test-sf.R

@@ -0,0 +1,17 @@
+test_that("Splitting a geometry by a complex line returns more regions", {
+  line <- sf::st_sfc(c(sf::st_linestring(cbind(c(-2, 2), c(0, 0))),
+                       sf::st_linestring(cbind(c(-0.5, 0, 0.5), c(0, 0.5, 0)))))
+  geometry <- sf::st_sfc(sf::st_polygon(list(cbind(c(-1, -1, 1, 1, -1),
+                                                   c(-1, 1, 1, -1, -1)))))
+  regions <- split(geometry, line)
+  expect_equal(length(regions), 3)
+})
+
+test_that("Splitting a geometry by a complex line still returns two edges", {
+  line <- sf::st_sfc(c(sf::st_linestring(cbind(c(-2, 2), c(0, 0))),
+                       sf::st_linestring(cbind(c(-0.5, 0, 0.5), c(0, 0.5, 0)))))
+  geometry <- sf::st_sfc(sf::st_polygon(list(cbind(c(-1, -1, 1, 1, -1),
+                                                   c(-1, 1, 1, -1, -1)))))
+  edges <- split(geometry, line, boundary = TRUE)
+  expect_equal(length(edges), 2)
+})