From 4a31bf9bda1e7922ef661ff6977a4c99d2baa561 Mon Sep 17 00:00:00 2001 From: Francesco Nattino Date: Mon, 18 Nov 2024 13:30:29 +0100 Subject: [PATCH 01/38] add rcoins dependency --- DESCRIPTION | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index a425959..f5b6088 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -13,27 +13,30 @@ Description: CRiSp (City River Spaces) provides tools to automate the License: Apache License (>= 2) URL: https://cityriverspaces.github.io/CRiSp/ BugReports: https://github.com/CityRiverSpaces/crisp/issues -Depends: +Depends: R (>= 2.10) -Imports: +Imports: dplyr, lwgeom, osmdata, + rcoins, rlang, sf, sfnetworks, stringr, tidygraph -Suggests: +Suggests: ggplot2, gridExtra, knitr, rmarkdown, testthat (>= 3.0.0) -VignetteBuilder: +VignetteBuilder: knitr Config/testthat/edition: 3 Encoding: UTF-8 LazyData: true Roxygen: list(markdown = TRUE) RoxygenNote: 7.3.2 +Remotes: + github::CityRiverSpaces/rcoins From d936da4e2ebeab9b97dab14acd4a2feb85bfd2da Mon Sep 17 00:00:00 2001 From: Francesco Nattino Date: Mon, 18 Nov 2024 14:35:16 +0100 Subject: [PATCH 02/38] add dbscan dependency --- DESCRIPTION | 1 + 1 file changed, 1 insertion(+) diff --git a/DESCRIPTION b/DESCRIPTION index f5b6088..325b2df 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -16,6 +16,7 @@ BugReports: https://github.com/CityRiverSpaces/crisp/issues Depends: R (>= 2.10) Imports: + dbscan, dplyr, lwgeom, osmdata, From 4b63d987df11fb55c2029ac4c81931574da28b25 Mon Sep 17 00:00:00 2001 From: Francesco Nattino Date: Mon, 18 Nov 2024 15:12:01 +0100 Subject: [PATCH 03/38] implement strokes function --- R/network.R | 24 ++++++++++++++++++++++-- man/strokes.Rd | 28 ++++++++++++++++++++++++++++ 2 files changed, 50 insertions(+), 2 deletions(-) create mode 100644 man/strokes.Rd diff --git a/R/network.R b/R/network.R index 7ed96f3..db254f4 100644 --- a/R/network.R +++ b/R/network.R @@ -308,6 +308,26 @@ filter_network <- function(network, target) { tidygraph::filter(sfnetworks::node_intersects(target)) } -strokes <- function() { - stop("`strokes` not yet implemented.") +#' Identify naturally continuos lines in a spatial network. +#' +#' Extend the specified network edges along the spatial network to form longer +#' strokes. See [`rcoins::stroke()`] for more details. +#' +#' @param network A spatial network object +#' @param from_edges The indices of the network edges to be continued +#' @param angle_threshold Consecutive line segments are considered part of the +#' same continuous line if the internal angle they form is larger than +#' `angle_threshold`` (in degrees). Should be in the range [0, 180) degrees +#' @param flow_mode If TRUE, line segments that belong to the same edge are not +#' split across strokes (even if they form internal angles smaller than +#' `angle_threshold`). +#' +#' @return Stroke geometries as a simple feature object +strokes <- function( + network, from_edges, angle_threshold = 0., flow_mode = FALSE +) { + rcoins::strokes( + network, angle_threshold = angle_threshold, attributes = FALSE, + flow_mode = flow_mode, from_edges = from_edges + ) } diff --git a/man/strokes.Rd b/man/strokes.Rd new file mode 100644 index 0000000..042a36c --- /dev/null +++ b/man/strokes.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/network.R +\name{strokes} +\alias{strokes} +\title{Identify naturally continuos lines in a spatial network.} +\usage{ +strokes(network, from_edges, angle_threshold = 0, flow_mode = FALSE) +} +\arguments{ +\item{network}{A spatial network object} + +\item{from_edges}{The indices of the network edges to be continued} + +\item{angle_threshold}{Consecutive line segments are considered part of the +same continuous line if the internal angle they form is larger than +`angle_threshold`` (in degrees). Should be in the range [0, 180) degrees} + +\item{flow_mode}{If TRUE, line segments that belong to the same edge are not +split across strokes (even if they form internal angles smaller than +\code{angle_threshold}).} +} +\value{ +Stroke geometries as a simple feature object +} +\description{ +Extend the specified network edges along the spatial network to form longer +strokes. See \code{\link[rcoins:stroke]{rcoins::stroke()}} for more details. +} From fa6049aa8b94bc7c59167305c3310fb0e87d9fae Mon Sep 17 00:00:00 2001 From: Francesco Nattino Date: Wed, 20 Nov 2024 08:48:41 +0100 Subject: [PATCH 04/38] first functions on segmentation --- NAMESPACE | 1 + R/segments.R | 56 +++++++++++++++++++++++++++++++++++++++ man/cluster_crossings.Rd | 27 +++++++++++++++++++ man/get_crossing_edges.Rd | 19 +++++++++++++ man/segments.Rd | 21 +++++++++++++++ 5 files changed, 124 insertions(+) create mode 100644 R/segments.R create mode 100644 man/cluster_crossings.Rd create mode 100644 man/get_crossing_edges.Rd create mode 100644 man/segments.Rd diff --git a/NAMESPACE b/NAMESPACE index 46d13f4..ba19c66 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -15,5 +15,6 @@ export(get_osm_river) export(get_osm_streets) export(get_osmdata) export(osmdata_as_sf) +export(segments) importFrom(rlang,":=") importFrom(rlang,.data) diff --git a/R/segments.R b/R/segments.R new file mode 100644 index 0000000..c273a0d --- /dev/null +++ b/R/segments.R @@ -0,0 +1,56 @@ +#' Split a river corridor into segments +#' +#' @param corridor The river corridor as a simple feature geometry +#' @param network The spatial network to be used for the segmentation +#' @param river_centerline The river centerline as a simple feature geometry +#' +#' @return Segment polygons as a simple feature geometry +#' @export +segments <- function(corridor, network, river_centerline) { + + crossings <- get_crossing_edges(network, river_centerline) + # TODO: remove hard coded angle threshold + crossings_strokes <- strokes(network, crossings, angle_threshold = 100.) + + crossings_clustered <- cluster_crossings(crossings_strokes, river_centerline) +} + + +#' Identify network edges that are crossing the river. +#' +#' @param network A spatial network object +#' @param river The river geometry as a simple feature object +#' +#' @return Indices of the edges crossing the river +get_crossing_edges <- function(network, river) { + edges <- sf::st_as_sf(network, "edges") + which(sf::st_intersects(edges, river, sparse = FALSE)) +} + +#' Group the river crossingns into clusters. +#' +#' 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 +#' edges representing e.g. different lanes of the same street are treated as +#' part of the same crossing. +#' +#' @param crossings Crossing edge geometries as a simple feature object +#' @param river The river geometry as a simple feature object +#' @param eps DBSCAN parameter referring to the size (radius) distance of the +#' neighborhood. Should approximate the distance between edges that we want +#' to consider as a single river crossing +#' +#' @return A simple feature geometry where the `cluster` column labels crossings +#' that are part of the same group +cluster_crossings <- function(crossings, river, eps = 100) { + intersections <- sf::st_intersection(crossings, river) + # By computing centroids we make sure we only have POINT geometries here + intersections_centroids <- sf::st_centroid(intersections) + intersections_coords <- sf::st_coordinates(intersections_centroids) + # We should not enforce a min mumber of elements - one-element clusters are OK + db <- dbscan::dbscan(intersections_coords, eps = eps, minPts = 1) + + crossings_clustered <- sf::st_as_sf(crossings) + crossings_clustered$cluster <- db$cluster + crossings_clustered +} diff --git a/man/cluster_crossings.Rd b/man/cluster_crossings.Rd new file mode 100644 index 0000000..9c4d178 --- /dev/null +++ b/man/cluster_crossings.Rd @@ -0,0 +1,27 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/segments.R +\name{cluster_crossings} +\alias{cluster_crossings} +\title{Group the river crossingns into clusters.} +\usage{ +cluster_crossings(crossings, river, eps = 100) +} +\arguments{ +\item{crossings}{Crossing edge geometries as a simple feature object} + +\item{river}{The river geometry as a simple feature object} + +\item{eps}{DBSCAN parameter referring to the size (radius) distance of the +neighborhood. Should approximate the distance between edges that we want +to consider as a single river crossing} +} +\value{ +A simple feature geometry where the \code{cluster} column labels crossings +that are part of the same group +} +\description{ +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 +edges representing e.g. different lanes of the same street are treated as +part of the same crossing. +} diff --git a/man/get_crossing_edges.Rd b/man/get_crossing_edges.Rd new file mode 100644 index 0000000..e0100df --- /dev/null +++ b/man/get_crossing_edges.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/segments.R +\name{get_crossing_edges} +\alias{get_crossing_edges} +\title{Identify network edges that are crossing the river.} +\usage{ +get_crossing_edges(network, river) +} +\arguments{ +\item{network}{A spatial network object} + +\item{river}{The river geometry as a simple feature object} +} +\value{ +Indices of the edges crossing the river +} +\description{ +Identify network edges that are crossing the river. +} diff --git a/man/segments.Rd b/man/segments.Rd new file mode 100644 index 0000000..035b045 --- /dev/null +++ b/man/segments.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/segments.R +\name{segments} +\alias{segments} +\title{Split a river corridor into segments} +\usage{ +segments(corridor, network, river_centerline) +} +\arguments{ +\item{corridor}{The river corridor as a simple feature geometry} + +\item{network}{The spatial network to be used for the segmentation} + +\item{river_centerline}{The river centerline as a simple feature geometry} +} +\value{ +Segment polygons as a simple feature geometry +} +\description{ +Split a river corridor into segments +} From 865b80172389a7553ac7146710a673cc09319e44 Mon Sep 17 00:00:00 2001 From: Francesco Nattino Date: Thu, 28 Nov 2024 09:26:34 +0100 Subject: [PATCH 05/38] fix rcoins syntax --- R/network.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/R/network.R b/R/network.R index 42c4354..82c31c6 100644 --- a/R/network.R +++ b/R/network.R @@ -324,10 +324,10 @@ filter_network <- function(network, target) { #' #' @return Stroke geometries as a simple feature object strokes <- function( - network, from_edges, angle_threshold = 0., flow_mode = FALSE + network, from_edge, angle_threshold = 0., flow_mode = FALSE ) { - rcoins::strokes( + rcoins::stroke( network, angle_threshold = angle_threshold, attributes = FALSE, - flow_mode = flow_mode, from_edges = from_edges + flow_mode = flow_mode, from_edge = from_edge ) } From cbc0ae35ac96b36a0f316a45c017e03c6da3715e Mon Sep 17 00:00:00 2001 From: Francesco Nattino Date: Thu, 28 Nov 2024 09:27:09 +0100 Subject: [PATCH 06/38] generalize function --- R/segments.R | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/R/segments.R b/R/segments.R index c273a0d..4effc78 100644 --- a/R/segments.R +++ b/R/segments.R @@ -16,15 +16,15 @@ segments <- function(corridor, network, river_centerline) { } -#' Identify network edges that are crossing the river. +#' Identify network edges that are intersecting a geometry. #' #' @param network A spatial network object -#' @param river The river geometry as a simple feature object +#' @param river A simple feature geometry #' -#' @return Indices of the edges crossing the river -get_crossing_edges <- function(network, river) { +#' @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, river, sparse = FALSE)) + which(sf::st_intersects(edges, geometry, sparse = FALSE)) } #' Group the river crossingns into clusters. From 57aea1940e08b6ca06017ff9290798617c2160ee Mon Sep 17 00:00:00 2001 From: Francesco Nattino Date: Thu, 28 Nov 2024 09:27:28 +0100 Subject: [PATCH 07/38] include angle threshold as input arg --- R/segments.R | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/R/segments.R b/R/segments.R index 4effc78..aec6a1c 100644 --- a/R/segments.R +++ b/R/segments.R @@ -3,15 +3,14 @@ #' @param corridor The river corridor as a simple feature geometry #' @param network The spatial network to be used for the segmentation #' @param river_centerline The river centerline as a simple feature geometry +#' @param angle_threshold Only angles above this threshold will be included #' #' @return Segment polygons as a simple feature geometry #' @export -segments <- function(corridor, network, river_centerline) { - - crossings <- get_crossing_edges(network, river_centerline) - # TODO: remove hard coded angle threshold - crossings_strokes <- strokes(network, crossings, angle_threshold = 100.) +segments <- function(corridor, network, river_centerline, angle_threshold) { + crossings <- get_intersecting_edges(network, river_centerline) + crossings_strokes <- strokes(network, crossings, angle_threshold) crossings_clustered <- cluster_crossings(crossings_strokes, river_centerline) } From 73697be1c95e7471dce31c702defd403c97797b7 Mon Sep 17 00:00:00 2001 From: Francesco Nattino Date: Sun, 15 Dec 2024 22:57:38 +0100 Subject: [PATCH 08/38] Add segment implementation --- NAMESPACE | 1 - R/corridor.R | 12 +- R/delineate.R | 26 ++- R/segments.R | 212 +++++++++++++++++- man/clip_and_filter.Rd | 24 ++ man/delineate_corridor.Rd | 5 + man/delineate_segments.Rd | 14 -- ...luster_crossings.Rd => filter_clusters.Rd} | 13 +- man/get_crossing_edges.Rd | 19 -- man/segments.Rd | 8 +- man/split.Rd | 4 +- man/strokes.Rd | 6 +- tests/testthat/test-corridor.R | 18 ++ 13 files changed, 290 insertions(+), 72 deletions(-) create mode 100644 man/clip_and_filter.Rd delete mode 100644 man/delineate_segments.Rd rename man/{cluster_crossings.Rd => filter_clusters.Rd} (68%) delete mode 100644 man/get_crossing_edges.Rd diff --git a/NAMESPACE b/NAMESPACE index 01881f4..af47210 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -6,7 +6,6 @@ export(clean_network) export(corridor) export(delineate_corridor) export(delineate_riverspace) -export(delineate_segments) export(flatten_network) export(get_osm_bb) export(get_osm_city_boundary) diff --git a/R/corridor.R b/R/corridor.R index 14c50b0..8c5402d 100644 --- a/R/corridor.R +++ b/R/corridor.R @@ -133,11 +133,19 @@ split_aoi <- function(bbox, river) { #' #' @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) { - lwgeom::st_split(geometry, line) |> +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 diff --git a/R/delineate.R b/R/delineate.R index 9146361..dff1d02 100644 --- a/R/delineate.R +++ b/R/delineate.R @@ -11,6 +11,9 @@ #' @param capping_method The method employed to connect the corridor edge end #' points (i.e. to "cap" the corridor). See [cap_corridor()] for #' the available methods +#' @param angle_threshold Only network edges forming angles above this threshold +#' (in degrees) are considered when forming segment edges. See `[segments()]` +#' and [strokes()]. Only used if `segments` is TRUE. #' @param segments Whether to carry out the corridor segmentation #' @param riverspace Whether to carry out the riverspace delineation #' @@ -18,8 +21,8 @@ #' @export delineate_corridor <- function( city_name, river_name, crs = NULL, bbox_buffer = NULL, - initial_method = "buffer", capping_method = "direct", segments = FALSE, - riverspace = FALSE + initial_method = "buffer", capping_method = "direct", angle_threshold = 90, + segments = FALSE, riverspace = FALSE ) { # Retrieve all relevant OSM datasets using the extended bounding box osm_data <- get_osmdata(city_name, river_name, crs, bbox_buffer) @@ -37,20 +40,19 @@ delineate_corridor <- function( initial_method, capping_method ) - if (segments) delineate_segments() + if (segments) { + # Select the relevant part of the network + buffer_corridor <- 100 # TODO should this be an additional input parameter? + corridor_buffer <- sf::st_buffer(corridor, buffer_corridor) + network_filtered <- filter_network(network, corridor_buffer) + + corridor <- segments(corridor, network_filtered, osm_data$river_centerline, + angle_threshold) + } if (riverspace) delineate_riverspace() return(corridor) } - -#' Delineate segments of a river corridor. -#' -#' @return A simple feature geometry -#' @export -delineate_segments <- function() { - stop("Segmentation not yet implemented.") -} - #' Delinate the riverspace. #' #' @return A simple feature geometry diff --git a/R/segments.R b/R/segments.R index aec6a1c..b726e09 100644 --- a/R/segments.R +++ b/R/segments.R @@ -1,19 +1,33 @@ #' Split a river corridor into segments #' +#' Segments are defined as corridor subregions separated by river-crossing +#' transversal lines that form continuous strokes in the network. +#' #' @param corridor The river corridor as a simple feature geometry #' @param network The spatial network to be used for the segmentation #' @param river_centerline The river centerline as a simple feature geometry -#' @param angle_threshold Only angles above this threshold will be included +#' @param angle_threshold Only consider angles above this threshold (in degrees) +#' to form continuous strokes in the network #' #' @return Segment polygons as a simple feature geometry #' @export -segments <- function(corridor, network, river_centerline, angle_threshold) { +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_strokes <- strokes(network, crossings, angle_threshold) - crossings_clustered <- cluster_crossings(crossings_strokes, river_centerline) -} + crossing_strokes <- strokes(network, crossings, angle_threshold) + + # Clip strokes and select the ones that could be used as segment boundaries + block_edges <- clip_and_filter(crossing_strokes, corridor, river_centerline) + # Split the corridor into candidate segments ("blocks") + blocks <- split(corridor, block_edges) + + # Refine the blocks to make sure that all segments touch the river and cross + # the corridor from side to side + refine_segments(blocks, river_centerline, corridor) +} #' Identify network edges that are intersecting a geometry. #' @@ -26,12 +40,99 @@ get_intersecting_edges <- function(network, geometry) { which(sf::st_intersects(edges, geometry, sparse = FALSE)) } -#' Group the river crossingns into clusters. +#' 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 +#' side to side are considered valid segment edges. We group valid segment edges +#' that cross the river in nearby locations, and select the shortest line per +#' cluster. +#' +#' @param lines Candidate segment edges as a simple feature geometry +#' @param corridor The river corridor as a simple feature geometry +#' @param river_centerline The river centerline as a simple feature geometry +#' +#' @return Candidate segment edges as a simple feature geometry +#' @importFrom rlang .data +clip_and_filter <- function(lines, corridor, river_centerline) { + + # Split corridor along the river centerline to find edges on the two sides + corridor_edges <- split(corridor, river_centerline, boundary = TRUE) + + # Clip the lines, keeping the only fragments that intersect the river + lines_clipped <- sf::st_intersection(lines, corridor) |> + sf::st_as_sf() |> + dplyr::filter(sf::st_is(.data$x, c("MULTILINESTRING", "LINESTRING"))) |> + sfheaders::sf_cast("LINESTRING") |> + sf::st_filter(river_centerline, .predicate = sf::st_intersects) |> + sf::st_geometry() + + # Select the fragments that cross the river only once and intersect both + # sides of the corridor + river_intersections <- sf::st_intersection(lines_clipped, river_centerline) + # TODO: we could generalize the following to allow for more complex river + # geometries (e.g. for river islands) + intersects_river <- sf::st_is(river_intersections, "POINT") + intersects_side_1 <- sf::st_intersects(lines_clipped, corridor_edges[[1]], + sparse = FALSE) + intersects_side_2 <- sf::st_intersects(lines_clipped, corridor_edges[[2]], + sparse = FALSE) + is_valid <- intersects_river & intersects_side_1 & intersects_side_2 + lines_valid <- lines_clipped[is_valid] + + # Cluster valid segment edges and select the shortest line per cluster + filter_clusters(lines_valid, river_centerline) +} + +#' Refine candidate segments via recursive merging +#' +#' Recursively merge the candidate segments provided ("blocks"), until they all +#' intersect the river centerline and both sides of the corridor. +#' +#' @param blocks Candidate segments as a simple feature geometry +#' @param river_centerline The river centerline as a simple feature geometry +#' @param corridor The river corridor as a simple feature geometry +#' +#' @return Refined corridor segments as a simple feature geometry +refine_segments <- function(blocks, river_centerline, corridor) { + + # Split corridor along the river centerline to find edges on the two sides + corridor_edges <- split(corridor, river_centerline, boundary = TRUE) + + # Recursively merge blocks until all blocks intersect the river + not_intersect_river <- function(blocks) { + idx_instersect_river <- find_intersects(blocks, river_centerline) + idx <- seq_along(blocks) + idx[!idx %in% idx_instersect_river] + } + while (TRUE) { + idx_not_instersects_river <- not_intersect_river(blocks) + if (length(idx_not_instersects_river) == 0) break + blocks <- merge_blocks(blocks, idx_not_instersects_river, + how = "longest-intersection") + } + + # Recursively merge blocks until all blocks intersect both edges + not_intersect_both_edges <- function(blocks) { + idx_intersects_edge_1 <- find_intersects(blocks, corridor_edges[1]) + idx_intersects_edge_2 <- find_intersects(blocks, corridor_edges[2]) + idx <- seq_along(blocks) + idx[!(idx %in% idx_intersects_edge_1 & idx %in% idx_intersects_edge_2)] + } + while (TRUE) { + idx_not_intersect_both_edges <- not_intersect_both_edges(blocks) + if (length(idx_not_intersect_both_edges) == 0) break + blocks <- merge_blocks(blocks, idx_not_intersect_both_edges, + how = "smallest") + } + return(blocks) +} + +#' 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 #' edges representing e.g. different lanes of the same street are treated as -#' part of the same crossing. +#' part of the same crossing. For each cluster, select the shortest edge. #' #' @param crossings Crossing edge geometries as a simple feature object #' @param river The river geometry as a simple feature object @@ -39,9 +140,8 @@ get_intersecting_edges <- function(network, geometry) { #' neighborhood. Should approximate the distance between edges that we want #' to consider as a single river crossing #' -#' @return A simple feature geometry where the `cluster` column labels crossings -#' that are part of the same group -cluster_crossings <- function(crossings, river, eps = 100) { +#' @return A simple feature geometry including the shortest edge per cluster +filter_clusters <- function(crossings, river, eps = 100) { intersections <- sf::st_intersection(crossings, river) # By computing centroids we make sure we only have POINT geometries here intersections_centroids <- sf::st_centroid(intersections) @@ -51,5 +151,95 @@ cluster_crossings <- function(crossings, river, eps = 100) { crossings_clustered <- sf::st_as_sf(crossings) crossings_clustered$cluster <- db$cluster - crossings_clustered + crossings_clustered$length <- sf::st_length(crossings_clustered) + crossings_clustered |> + dplyr::group_by(.data$cluster) |> + dplyr::filter(length == min(length)) +} + +#' Merge a set of blocks to adjacent ones +#' +#' Adjacent blocks are defined as the blocks that are neighbours to the blocks +#' that need to be merged, and that intersect them via a (Multi)LineString. We +#' consider the blocks to merge one by one, from the smallest to the largest, +#' merging them to the other blocks recursively. +#' +#' @param blocks Simple feature geometry representing all the blocks +#' @param to_merge Indices of the blocks to merge +#' @param how Strategy for merging, see [merge_block()] +#' +#' @return Blocks merged to the specified ones as a simple feature geometry +merge_blocks <- function(blocks, to_merge, how = "longest-intersection") { + if (length(to_merge) == 0) { + return(blocks) + } + # Pick the first block to merge, i.e. the smallest one, and the targets + idx_smallest <- find_smallest(blocks[to_merge]) + idx_current <- to_merge[idx_smallest] + current <- blocks[idx_current] + targets <- blocks[!seq_along(blocks) %in% idx_current] + # Keep track of the geometries of the blocks that still need merging: their + # position in the list of blocks might change after merging the current one! + idx_others <- to_merge[!seq_along(to_merge) %in% idx_smallest] + others <- blocks[idx_others] + # Merge current block with one of the targets + merged <- merge_block(targets, current, how = how) + # Determine the new indices of the other blocks that need to be merged + is_equal <- sf::st_equals(merged, others, sparse = TRUE) + idx_others <- which(apply(is_equal, any, MARGIN = 1)) + # Continue merging other blocks, recursively + merge_blocks(blocks = merged, to_merge = idx_others, how = how) +} + +#' Merge a block to one of the target geometries +#' +#' @param targets Sequence of target blocks as a simple feature geometry +#' @param block Block to merge as a simple feature geometry +#' @param how Strategy for merging, choose between "smallest" (merge to smallest +#' adjacent block) and "longest-intersection" (merge to block which it shares +#' the longest intersection with) +#' +#' @return Blocks merged to the specified one as a simple feature geometry +merge_block <- function(targets, block, how = "longest-intersection") { + idx_adjacent <- find_adjacent(targets, block) + if (how == "longest-intersection") { + intersections <- sf::st_intersection(targets[idx_adjacent], block) + idx_longest_intersection <- find_longest(intersections) + idx_to_merge <- idx_adjacent[idx_longest_intersection] + } else if (how == "smallest") { + idx_smallest <- find_smallest(targets[idx_adjacent]) + idx_to_merge <- idx_adjacent[idx_smallest] + } else { + stop(sprintf("Method '%s' unknown", how)) + } + merged <- sf::st_union(targets[idx_to_merge], block) + others <- targets[!seq_along(targets) %in% idx_to_merge] + return(c(others, merged)) +} + +#' @noRd +find_smallest <- function(geometry) { + area <- sf::st_area(geometry) + return(which.min(area)) +} + +#' @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)) +} + +#' @noRd +find_adjacent <- function(geometry, target) { + idx_neighbour <- find_intersects(geometry, target) + intersections <- sf::st_intersection(geometry[idx_neighbour], target) + is_adjacent_intersections <- sf::st_is(intersections, + c("MULTILINESTRING", "LINESTRING")) + return(idx_neighbour[is_adjacent_intersections]) } diff --git a/man/clip_and_filter.Rd b/man/clip_and_filter.Rd new file mode 100644 index 0000000..2b21453 --- /dev/null +++ b/man/clip_and_filter.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/segments.R +\name{clip_and_filter} +\alias{clip_and_filter} +\title{Clip lines to the extent of the corridor, and filter valid segment edges} +\usage{ +clip_and_filter(lines, corridor, river_centerline) +} +\arguments{ +\item{lines}{Candidate segment edges as a simple feature geometry} + +\item{corridor}{The river corridor as a simple feature geometry} + +\item{river_centerline}{The river centerline as a simple feature geometry} +} +\value{ +Candidate segment edges as a simple feature geometry +} +\description{ +Lines that intersect the river only once and that cross the corridor from +side to side are considered valid segment edges. We group valid segment edges +that cross the river in nearby locations, and select the shortest line per +cluster. +} diff --git a/man/delineate_corridor.Rd b/man/delineate_corridor.Rd index 75a925b..f28c0a7 100644 --- a/man/delineate_corridor.Rd +++ b/man/delineate_corridor.Rd @@ -11,6 +11,7 @@ delineate_corridor( bbox_buffer = NULL, initial_method = "buffer", capping_method = "direct", + angle_threshold = 90, segments = FALSE, riverspace = FALSE ) @@ -33,6 +34,10 @@ corridor geometry. See \code{\link[=initial_corridor]{initial_corridor()}} for t points (i.e. to "cap" the corridor). See \code{\link[=cap_corridor]{cap_corridor()}} for the available methods} +\item{angle_threshold}{Only network edges forming angles above this threshold +(in degrees) are considered when forming segment edges. See \verb{[segments()]} +and \code{\link[=strokes]{strokes()}}. Only used if \code{segments} is TRUE.} + \item{segments}{Whether to carry out the corridor segmentation} \item{riverspace}{Whether to carry out the riverspace delineation} diff --git a/man/delineate_segments.Rd b/man/delineate_segments.Rd deleted file mode 100644 index 76442a3..0000000 --- a/man/delineate_segments.Rd +++ /dev/null @@ -1,14 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/delineate.R -\name{delineate_segments} -\alias{delineate_segments} -\title{Delineate segments of a river corridor.} -\usage{ -delineate_segments() -} -\value{ -A simple feature geometry -} -\description{ -Delineate segments of a river corridor. -} diff --git a/man/cluster_crossings.Rd b/man/filter_clusters.Rd similarity index 68% rename from man/cluster_crossings.Rd rename to man/filter_clusters.Rd index 9c4d178..c1f6dbc 100644 --- a/man/cluster_crossings.Rd +++ b/man/filter_clusters.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/segments.R -\name{cluster_crossings} -\alias{cluster_crossings} -\title{Group the river crossingns into clusters.} +\name{filter_clusters} +\alias{filter_clusters} +\title{Cluster the river crossings and select the shortest crossing per cluster.} \usage{ -cluster_crossings(crossings, river, eps = 100) +filter_clusters(crossings, river, eps = 100) } \arguments{ \item{crossings}{Crossing edge geometries as a simple feature object} @@ -16,12 +16,11 @@ neighborhood. Should approximate the distance between edges that we want to consider as a single river crossing} } \value{ -A simple feature geometry where the \code{cluster} column labels crossings -that are part of the same group +A simple feature geometry including the shortest edge per cluster } \description{ 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 edges representing e.g. different lanes of the same street are treated as -part of the same crossing. +part of the same crossing. For each cluster, select the shortest edge. } diff --git a/man/get_crossing_edges.Rd b/man/get_crossing_edges.Rd deleted file mode 100644 index e0100df..0000000 --- a/man/get_crossing_edges.Rd +++ /dev/null @@ -1,19 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/segments.R -\name{get_crossing_edges} -\alias{get_crossing_edges} -\title{Identify network edges that are crossing the river.} -\usage{ -get_crossing_edges(network, river) -} -\arguments{ -\item{network}{A spatial network object} - -\item{river}{The river geometry as a simple feature object} -} -\value{ -Indices of the edges crossing the river -} -\description{ -Identify network edges that are crossing the river. -} diff --git a/man/segments.Rd b/man/segments.Rd index 035b045..20fe75f 100644 --- a/man/segments.Rd +++ b/man/segments.Rd @@ -4,7 +4,7 @@ \alias{segments} \title{Split a river corridor into segments} \usage{ -segments(corridor, network, river_centerline) +segments(corridor, network, river_centerline, angle_threshold = 90) } \arguments{ \item{corridor}{The river corridor as a simple feature geometry} @@ -12,10 +12,14 @@ segments(corridor, network, river_centerline) \item{network}{The spatial network to be used for the segmentation} \item{river_centerline}{The river centerline as a simple feature geometry} + +\item{angle_threshold}{Only consider angles above this threshold (in degrees) +to form continuous strokes in the network} } \value{ Segment polygons as a simple feature geometry } \description{ -Split a river corridor into segments +Segments are defined as corridor subregions separated by river-crossing +transversal lines that form continuous strokes in the network. } diff --git a/man/split.Rd b/man/split.Rd index 68e6f26..2ffaa76 100644 --- a/man/split.Rd +++ b/man/split.Rd @@ -4,12 +4,14 @@ \alias{split} \title{Split a geometry along a (multi)linestring.} \usage{ -split(geometry, line) +split(geometry, line, boundary = FALSE) } \arguments{ \item{geometry}{Geometry to split} \item{line}{Dividing (multi)linestring} + +\item{boundary}{Whether to return the split boundary instead of the regions} } \value{ A simple feature object diff --git a/man/strokes.Rd b/man/strokes.Rd index 042a36c..6c9ba43 100644 --- a/man/strokes.Rd +++ b/man/strokes.Rd @@ -4,13 +4,11 @@ \alias{strokes} \title{Identify naturally continuos lines in a spatial network.} \usage{ -strokes(network, from_edges, angle_threshold = 0, flow_mode = FALSE) +strokes(network, from_edge, angle_threshold = 0, flow_mode = FALSE) } \arguments{ \item{network}{A spatial network object} -\item{from_edges}{The indices of the network edges to be continued} - \item{angle_threshold}{Consecutive line segments are considered part of the same continuous line if the internal angle they form is larger than `angle_threshold`` (in degrees). Should be in the range [0, 180) degrees} @@ -18,6 +16,8 @@ same continuous line if the internal angle they form is larger than \item{flow_mode}{If TRUE, line segments that belong to the same edge are not split across strokes (even if they form internal angles smaller than \code{angle_threshold}).} + +\item{from_edges}{The indices of the network edges to be continued} } \value{ Stroke geometries as a simple feature object diff --git a/tests/testthat/test-corridor.R b/tests/testthat/test-corridor.R index 5cd0325..19232e0 100644 --- a/tests/testthat/test-corridor.R +++ b/tests/testthat/test-corridor.R @@ -65,6 +65,24 @@ 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", { # ____________ # | | From 1ff7d8de6bae7d31f6e4763ee89a6f4742388332 Mon Sep 17 00:00:00 2001 From: Francesco Nattino Date: Sun, 15 Dec 2024 23:59:42 +0100 Subject: [PATCH 09/38] fix typo --- R/network.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/network.R b/R/network.R index 82c31c6..e44a26c 100644 --- a/R/network.R +++ b/R/network.R @@ -314,7 +314,7 @@ filter_network <- function(network, target) { #' strokes. See [`rcoins::stroke()`] for more details. #' #' @param network A spatial network object -#' @param from_edges The indices of the network edges to be continued +#' @param from_edge The indices of the network edges to be continued #' @param angle_threshold Consecutive line segments are considered part of the #' same continuous line if the internal angle they form is larger than #' `angle_threshold`` (in degrees). Should be in the range [0, 180) degrees From 20657020c00a21cf0c3956dce445cb46b4fe89a6 Mon Sep 17 00:00:00 2001 From: Francesco Nattino Date: Mon, 16 Dec 2024 00:06:00 +0100 Subject: [PATCH 10/38] update man file --- man/strokes.Rd | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/man/strokes.Rd b/man/strokes.Rd index 6c9ba43..5690e86 100644 --- a/man/strokes.Rd +++ b/man/strokes.Rd @@ -9,6 +9,8 @@ strokes(network, from_edge, angle_threshold = 0, flow_mode = FALSE) \arguments{ \item{network}{A spatial network object} +\item{from_edge}{The indices of the network edges to be continued} + \item{angle_threshold}{Consecutive line segments are considered part of the same continuous line if the internal angle they form is larger than `angle_threshold`` (in degrees). Should be in the range [0, 180) degrees} @@ -16,8 +18,6 @@ same continuous line if the internal angle they form is larger than \item{flow_mode}{If TRUE, line segments that belong to the same edge are not split across strokes (even if they form internal angles smaller than \code{angle_threshold}).} - -\item{from_edges}{The indices of the network edges to be continued} } \value{ Stroke geometries as a simple feature object From fb0c43435c26a9a711395f7ec2ff1c5486121628 Mon Sep 17 00:00:00 2001 From: Francesco Nattino Date: Mon, 16 Dec 2024 00:06:16 +0100 Subject: [PATCH 11/38] update unrelated data files --- man/bucharest_dem.Rd | 8 +++++--- man/bucharest_osm.Rd | 15 +++++++++++---- 2 files changed, 16 insertions(+), 7 deletions(-) diff --git a/man/bucharest_dem.Rd b/man/bucharest_dem.Rd index 3c9d9e4..a6fd0b3 100644 --- a/man/bucharest_dem.Rd +++ b/man/bucharest_dem.Rd @@ -5,15 +5,17 @@ \alias{bucharest_dem} \title{CRiSp example DEM data for Bucharest} \format{ -TODO +A PackedSpatRaster object. Run \code{\link[terra:wrap]{terra::unwrap()}} to extract the +DEM as a SpatRaster object } \source{ -Copernicus DEM 30 +\url{https://spacedata.copernicus.eu/collections/copernicus-digital-elevation-model} } \usage{ bucharest_dem } \description{ -Digital Elevation Model (DEM) for examples used in the CRiSp package. +Copernicus GLO-30 Digital Elevation Model (DEM) cropped and retiled to cover +the city of Bucharest. Used for examples and vignettes in the CRiSp package. } \keyword{datasets} diff --git a/man/bucharest_osm.Rd b/man/bucharest_osm.Rd index de4739a..836e035 100644 --- a/man/bucharest_osm.Rd +++ b/man/bucharest_osm.Rd @@ -5,19 +5,26 @@ \alias{bucharest_osm} \title{CRiSp example OSM data for Bucharest} \format{ -A list with the following components: +A list of sf objects representing: \describe{ -\item{boundary}{A sf object representing the administrative boundary of -Bucharest.} +\item{bb}{The city bounding box.} +\item{boundary}{The administrative boundary of Bucharest.} +\item{river_centerline}{The Dâmbovița river centerline.} +\item{river_surface}{The Dâmbovița river area.} +\item{streets}{The street network.} +\item{railways}{The railway network.} } } \source{ -OpenStreetMap +\url{https://www.openstreetmap.org/about} } \usage{ bucharest_osm } \description{ Data extracted from OpenStreetMap for examples used in the CRiSp package. +All datasets are provided in a projected coordinate reference system +(UTM 35), with exception for the bounding box, which is provided as latitude/ +longitude coordinates (WGS84). } \keyword{datasets} From a27f63b381a93937c6484050103e6440431fdce0 Mon Sep 17 00:00:00 2001 From: Francesco Nattino Date: Tue, 17 Dec 2024 11:46:43 +0100 Subject: [PATCH 12/38] fix API --- NAMESPACE | 4 ++-- R/corridor.R | 2 +- R/delineate.R | 10 +++++----- R/segments.R | 4 ++-- man/{corridor.Rd => get_corridor.Rd} | 6 +++--- man/get_intersecting_edges.Rd | 19 +++++++++++++++++++ man/{segments.Rd => get_segments.Rd} | 6 +++--- man/merge_block.Rd | 23 +++++++++++++++++++++++ man/merge_blocks.Rd | 24 ++++++++++++++++++++++++ man/refine_segments.Rd | 22 ++++++++++++++++++++++ 10 files changed, 104 insertions(+), 16 deletions(-) rename man/{corridor.Rd => get_corridor.Rd} (95%) create mode 100644 man/get_intersecting_edges.Rd rename man/{segments.Rd => get_segments.Rd} (86%) create mode 100644 man/merge_block.Rd create mode 100644 man/merge_blocks.Rd create mode 100644 man/refine_segments.Rd diff --git a/NAMESPACE b/NAMESPACE index 72ec814..c022bd7 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -4,12 +4,12 @@ export(add_weights) export(as_bbox) export(as_network) export(clean_network) -export(corridor) export(delineate_corridor) export(delineate_riverspace) export(dem_to_cog) export(flatten_network) export(get_cd_char) +export(get_corridor) export(get_cost_distance) export(get_dem) export(get_osm_bb) @@ -18,6 +18,7 @@ export(get_osm_railways) export(get_osm_river) export(get_osm_streets) export(get_osmdata) +export(get_segments) export(get_slope) export(get_stac_asset_urls) export(get_utm_zone) @@ -31,7 +32,6 @@ export(mask_cost_distance) export(mask_slope) export(osmdata_as_sf) export(reproject) -export(segments) export(smooth_dem) importFrom(rlang,"!!") importFrom(rlang,":=") diff --git a/R/corridor.R b/R/corridor.R index 8c5402d..7287084 100644 --- a/R/corridor.R +++ b/R/corridor.R @@ -14,7 +14,7 @@ #' #' @return A simple feature geometry representing the river corridor #' @export -corridor <- function( +get_corridor <- function( network, river_centerline, river_surface, bbox, initial_method = "buffer", capping_method = "direct" ) { diff --git a/R/delineate.R b/R/delineate.R index dff1d02..88a2235 100644 --- a/R/delineate.R +++ b/R/delineate.R @@ -12,8 +12,8 @@ #' points (i.e. to "cap" the corridor). See [cap_corridor()] for #' the available methods #' @param angle_threshold Only network edges forming angles above this threshold -#' (in degrees) are considered when forming segment edges. See `[segments()]` -#' and [strokes()]. Only used if `segments` is TRUE. +#' (in degrees) are considered when forming segment edges. See +#' `[get_segments()]` and [strokes()]. Only used if `segments` is TRUE. #' @param segments Whether to carry out the corridor segmentation #' @param riverspace Whether to carry out the riverspace delineation #' @@ -35,7 +35,7 @@ delineate_corridor <- function( network <- as_network(network_edges) # Run the corridor delineation on the spatial network - corridor <- corridor( + corridor <- get_corridor( network, osm_data$river_centerline, osm_data$river_surface, bbox, initial_method, capping_method ) @@ -46,8 +46,8 @@ delineate_corridor <- function( corridor_buffer <- sf::st_buffer(corridor, buffer_corridor) network_filtered <- filter_network(network, corridor_buffer) - corridor <- segments(corridor, network_filtered, osm_data$river_centerline, - angle_threshold) + corridor <- get_segments(corridor, network_filtered, + osm_data$river_centerline, angle_threshold) } if (riverspace) delineate_riverspace() return(corridor) diff --git a/R/segments.R b/R/segments.R index b726e09..20b24ee 100644 --- a/R/segments.R +++ b/R/segments.R @@ -11,8 +11,8 @@ #' #' @return Segment polygons as a simple feature geometry #' @export -segments <- function(corridor, network, river_centerline, - angle_threshold = 90) { +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) diff --git a/man/corridor.Rd b/man/get_corridor.Rd similarity index 95% rename from man/corridor.Rd rename to man/get_corridor.Rd index 8ff6013..4980706 100644 --- a/man/corridor.Rd +++ b/man/get_corridor.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/corridor.R -\name{corridor} -\alias{corridor} +\name{get_corridor} +\alias{get_corridor} \title{Delineate a river corridor on a spatial network.} \usage{ -corridor( +get_corridor( network, river_centerline, river_surface, diff --git a/man/get_intersecting_edges.Rd b/man/get_intersecting_edges.Rd new file mode 100644 index 0000000..1ca0348 --- /dev/null +++ b/man/get_intersecting_edges.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/segments.R +\name{get_intersecting_edges} +\alias{get_intersecting_edges} +\title{Identify network edges that are intersecting a geometry.} +\usage{ +get_intersecting_edges(network, geometry) +} +\arguments{ +\item{network}{A spatial network object} + +\item{river}{A simple feature geometry} +} +\value{ +Indices of the edges intersecting the geometry as a vector +} +\description{ +Identify network edges that are intersecting a geometry. +} diff --git a/man/segments.Rd b/man/get_segments.Rd similarity index 86% rename from man/segments.Rd rename to man/get_segments.Rd index 20fe75f..36b4897 100644 --- a/man/segments.Rd +++ b/man/get_segments.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/segments.R -\name{segments} -\alias{segments} +\name{get_segments} +\alias{get_segments} \title{Split a river corridor into segments} \usage{ -segments(corridor, network, river_centerline, angle_threshold = 90) +get_segments(corridor, network, river_centerline, angle_threshold = 90) } \arguments{ \item{corridor}{The river corridor as a simple feature geometry} diff --git a/man/merge_block.Rd b/man/merge_block.Rd new file mode 100644 index 0000000..d8047c2 --- /dev/null +++ b/man/merge_block.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/segments.R +\name{merge_block} +\alias{merge_block} +\title{Merge a block to one of the target geometries} +\usage{ +merge_block(targets, block, how = "longest-intersection") +} +\arguments{ +\item{targets}{Sequence of target blocks as a simple feature geometry} + +\item{block}{Block to merge as a simple feature geometry} + +\item{how}{Strategy for merging, choose between "smallest" (merge to smallest +adjacent block) and "longest-intersection" (merge to block which it shares +the longest intersection with)} +} +\value{ +Blocks merged to the specified one as a simple feature geometry +} +\description{ +Merge a block to one of the target geometries +} diff --git a/man/merge_blocks.Rd b/man/merge_blocks.Rd new file mode 100644 index 0000000..563ebb7 --- /dev/null +++ b/man/merge_blocks.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/segments.R +\name{merge_blocks} +\alias{merge_blocks} +\title{Merge a set of blocks to adjacent ones} +\usage{ +merge_blocks(blocks, to_merge, how = "longest-intersection") +} +\arguments{ +\item{blocks}{Simple feature geometry representing all the blocks} + +\item{to_merge}{Indices of the blocks to merge} + +\item{how}{Strategy for merging, see \code{\link[=merge_block]{merge_block()}}} +} +\value{ +Blocks merged to the specified ones as a simple feature geometry +} +\description{ +Adjacent blocks are defined as the blocks that are neighbours to the blocks +that need to be merged, and that intersect them via a (Multi)LineString. We +consider the blocks to merge one by one, from the smallest to the largest, +merging them to the other blocks recursively. +} diff --git a/man/refine_segments.Rd b/man/refine_segments.Rd new file mode 100644 index 0000000..fcad0cd --- /dev/null +++ b/man/refine_segments.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/segments.R +\name{refine_segments} +\alias{refine_segments} +\title{Refine candidate segments via recursive merging} +\usage{ +refine_segments(blocks, river_centerline, corridor) +} +\arguments{ +\item{blocks}{Candidate segments as a simple feature geometry} + +\item{river_centerline}{The river centerline as a simple feature geometry} + +\item{corridor}{The river corridor as a simple feature geometry} +} +\value{ +Refined corridor segments as a simple feature geometry +} +\description{ +Recursively merge the candidate segments provided ("blocks"), until they all +intersect the river centerline and both sides of the corridor. +} From 254036af2130a9e598c868bc823e11f9055e96a9 Mon Sep 17 00:00:00 2001 From: Francesco Nattino Date: Tue, 17 Dec 2024 12:05:06 +0100 Subject: [PATCH 13/38] fix docstring --- R/segments.R | 2 +- man/delineate_corridor.Rd | 4 ++-- man/get_intersecting_edges.Rd | 2 +- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/R/segments.R b/R/segments.R index 20b24ee..589c7c5 100644 --- a/R/segments.R +++ b/R/segments.R @@ -32,7 +32,7 @@ get_segments <- function(corridor, network, river_centerline, #' Identify network edges that are intersecting a geometry. #' #' @param network A spatial network object -#' @param river A simple feature geometry +#' @param geometry A simple feature geometry #' #' @return Indices of the edges intersecting the geometry as a vector get_intersecting_edges <- function(network, geometry) { diff --git a/man/delineate_corridor.Rd b/man/delineate_corridor.Rd index f28c0a7..833ab6a 100644 --- a/man/delineate_corridor.Rd +++ b/man/delineate_corridor.Rd @@ -35,8 +35,8 @@ points (i.e. to "cap" the corridor). See \code{\link[=cap_corridor]{cap_corridor the available methods} \item{angle_threshold}{Only network edges forming angles above this threshold -(in degrees) are considered when forming segment edges. See \verb{[segments()]} -and \code{\link[=strokes]{strokes()}}. Only used if \code{segments} is TRUE.} +(in degrees) are considered when forming segment edges. See +\verb{[get_segments()]} and \code{\link[=strokes]{strokes()}}. Only used if \code{segments} is TRUE.} \item{segments}{Whether to carry out the corridor segmentation} diff --git a/man/get_intersecting_edges.Rd b/man/get_intersecting_edges.Rd index 1ca0348..8217842 100644 --- a/man/get_intersecting_edges.Rd +++ b/man/get_intersecting_edges.Rd @@ -9,7 +9,7 @@ get_intersecting_edges(network, geometry) \arguments{ \item{network}{A spatial network object} -\item{river}{A simple feature geometry} +\item{geometry}{A simple feature geometry} } \value{ Indices of the edges intersecting the geometry as a vector From 746ff4d097c06daf8b8702790e5f900a09ded2b3 Mon Sep 17 00:00:00 2001 From: Francesco Nattino Date: Tue, 17 Dec 2024 12:37:31 +0100 Subject: [PATCH 14/38] update vignette --- _pkgdown.yml | 6 +-- vignettes-drafts/corridor-segmentation.Rmd | 31 -------------- vignettes/corridor-segmentation.Rmd | 49 ++++++++++++++++++++++ 3 files changed, 52 insertions(+), 34 deletions(-) delete mode 100644 vignettes-drafts/corridor-segmentation.Rmd create mode 100644 vignettes/corridor-segmentation.Rmd diff --git a/_pkgdown.yml b/_pkgdown.yml index 6745fad..cd00ad5 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -12,7 +12,7 @@ articles: - getting-osm-data - network-preparation - corridor-delineation - # - corridor-segmentation + - corridor-segmentation # - riverspace-delineation # - multiple-cities # - poi-study-area @@ -33,8 +33,8 @@ navbar: - text: Delineation - text: 4. Corridor delineation href: articles/corridor-delineation.html - # - text: 5. Corridor segmentation - # href: articles/corridor-segmentation.html + - text: 5. Corridor segmentation + href: articles/corridor-segmentation.html # - text: 6. Riverspace delineation # href: articles/riverspace-delineation.html # - text: ------- diff --git a/vignettes-drafts/corridor-segmentation.Rmd b/vignettes-drafts/corridor-segmentation.Rmd deleted file mode 100644 index 66eae6b..0000000 --- a/vignettes-drafts/corridor-segmentation.Rmd +++ /dev/null @@ -1,31 +0,0 @@ ---- -title: "5. Corridor segmentation" -output: rmarkdown::html_vignette -vignette: > - %\VignetteIndexEntry{5. Corridor segmentation} - %\VignetteEngine{knitr::rmarkdown} - %\VignetteEncoding{UTF-8} ---- - -```{r, include = FALSE} -knitr::opts_chunk$set( - collapse = TRUE, - comment = "#>" -) -``` - -```{r setup} -library(CRiSp) -``` - -For a more detailed analysis of an urban river corridor, corridor-level delineation may not be sufficient. The corridor needs to be subdivided into smaller morphological units. Segmentation is a process of subdividing the corridor by using major transversal road or rail infrastructure lines. - -By default, the all-in-one function `delineate_corridor()` includes the division of the corridor into segments. It is also possible to use the `delineate_segment()` function to divide the corridor in a separate step. - -To demonstrate this as a separate step, we will use the `bucharest_osm$corridor` and `bucharest_osm$streets` layers from the package data as input. - -```{r eval=FALSE} -segmented_corridor <- delineate_segments(bucharest_osm$corridor, - bucharest_osm$streets) -``` - diff --git a/vignettes/corridor-segmentation.Rmd b/vignettes/corridor-segmentation.Rmd new file mode 100644 index 0000000..978abc9 --- /dev/null +++ b/vignettes/corridor-segmentation.Rmd @@ -0,0 +1,49 @@ +--- +title: "5. Corridor segmentation" +output: rmarkdown::html_vignette +vignette: > + %\VignetteIndexEntry{5. Corridor segmentation} + %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} +--- + +```{r, include = FALSE} +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>" +) +``` + +```{r setup} +library(CRiSp) +``` + +For a more detailed analysis of an urban river corridor, corridor-level delineation may not be sufficient. The corridor needs to be subdivided into smaller morphological units. Segmentation is a process of subdividing the corridor by using major transversal road or rail infrastructure lines. + +By default, the all-in-one function `delineate_corridor()` includes the division of the corridor into segments. It is also possible to use the `get_segments()` function to divide the corridor in a separate step. + +To demonstrate this as a separate step, we will use the `bucharest_osm$corridor` and `bucharest_osm$streets` layers from the package data as input. + +We first prepare the network and select all the streets and railways that cover the river corridor plus a small buffer region (see also `vignette("network-preparation")`): + +```{r eval=FALSE} +# TODO remove eval=FALSE when the corridor is available as packaged data +# Build combined street and railway network +network <- bind_rows(streets, railways) |> + as_sfnetwork(directed = FALSE) + +# Add a 100 meter buffer region to the corridor +corridor_buffer <- sf::st_buffer(bucharest_osm$corridor, 100) + +# Filter the network to the area of interest +network_filtered <- filter_network(network, corridor_buffer) +``` + +We then delineate segments in the corridor. The algorithm spits the corridor using river-crossing transversal edges that form continuous lines in the network: + +```{r eval=FALSE} +# TODO remove eval=FALSE when the corridor is available as packaged data +segmented_corridor <- get_segments(bucharest_osm$corridor, + network_filtered) +``` + From 1b2012c8e18cb2b4b9d6623313473ae23321394f Mon Sep 17 00:00:00 2001 From: Claudiu Forgaci Date: Tue, 17 Dec 2024 22:18:56 +0100 Subject: [PATCH 15/38] Add CoC --- .github/CODE_OF_CONDUCT.md | 126 +++++++++++++++++++++++++++++++++++++ 1 file changed, 126 insertions(+) create mode 100644 .github/CODE_OF_CONDUCT.md diff --git a/.github/CODE_OF_CONDUCT.md b/.github/CODE_OF_CONDUCT.md new file mode 100644 index 0000000..3ac34c8 --- /dev/null +++ b/.github/CODE_OF_CONDUCT.md @@ -0,0 +1,126 @@ +# Contributor Covenant Code of Conduct + +## Our Pledge + +We as members, contributors, and leaders pledge to make participation in our +community a harassment-free experience for everyone, regardless of age, body +size, visible or invisible disability, ethnicity, sex characteristics, gender +identity and expression, level of experience, education, socio-economic status, +nationality, personal appearance, race, caste, color, religion, or sexual +identity and orientation. + +We pledge to act and interact in ways that contribute to an open, welcoming, +diverse, inclusive, and healthy community. + +## Our Standards + +Examples of behavior that contributes to a positive environment for our +community include: + +* Demonstrating empathy and kindness toward other people +* Being respectful of differing opinions, viewpoints, and experiences +* Giving and gracefully accepting constructive feedback +* Accepting responsibility and apologizing to those affected by our mistakes, + and learning from the experience +* Focusing on what is best not just for us as individuals, but for the overall + community + +Examples of unacceptable behavior include: + +* The use of sexualized language or imagery, and sexual attention or advances of + any kind +* Trolling, insulting or derogatory comments, and personal or political attacks +* Public or private harassment +* Publishing others' private information, such as a physical or email address, + without their explicit permission +* Other conduct which could reasonably be considered inappropriate in a + professional setting + +## Enforcement Responsibilities + +Community leaders are responsible for clarifying and enforcing our standards of +acceptable behavior and will take appropriate and fair corrective action in +response to any behavior that they deem inappropriate, threatening, offensive, +or harmful. + +Community leaders have the right and responsibility to remove, edit, or reject +comments, commits, code, wiki edits, issues, and other contributions that are +not aligned to this Code of Conduct, and will communicate reasons for moderation +decisions when appropriate. + +## Scope + +This Code of Conduct applies within all community spaces, and also applies when +an individual is officially representing the community in public spaces. +Examples of representing our community include using an official e-mail address, +posting via an official social media account, or acting as an appointed +representative at an online or offline event. + +## Enforcement + +Instances of abusive, harassing, or otherwise unacceptable behavior may be +reported to the community leaders responsible for enforcement at codeofconduct@posit.co. +All complaints will be reviewed and investigated promptly and fairly. + +All community leaders are obligated to respect the privacy and security of the +reporter of any incident. + +## Enforcement Guidelines + +Community leaders will follow these Community Impact Guidelines in determining +the consequences for any action they deem in violation of this Code of Conduct: + +### 1. Correction + +**Community Impact**: Use of inappropriate language or other behavior deemed +unprofessional or unwelcome in the community. + +**Consequence**: A private, written warning from community leaders, providing +clarity around the nature of the violation and an explanation of why the +behavior was inappropriate. A public apology may be requested. + +### 2. Warning + +**Community Impact**: A violation through a single incident or series of +actions. + +**Consequence**: A warning with consequences for continued behavior. No +interaction with the people involved, including unsolicited interaction with +those enforcing the Code of Conduct, for a specified period of time. This +includes avoiding interactions in community spaces as well as external channels +like social media. Violating these terms may lead to a temporary or permanent +ban. + +### 3. Temporary Ban + +**Community Impact**: A serious violation of community standards, including +sustained inappropriate behavior. + +**Consequence**: A temporary ban from any sort of interaction or public +communication with the community for a specified period of time. No public or +private interaction with the people involved, including unsolicited interaction +with those enforcing the Code of Conduct, is allowed during this period. +Violating these terms may lead to a permanent ban. + +### 4. Permanent Ban + +**Community Impact**: Demonstrating a pattern of violation of community +standards, including sustained inappropriate behavior, harassment of an +individual, or aggression toward or disparagement of classes of individuals. + +**Consequence**: A permanent ban from any sort of public interaction within the +community. + +## Attribution + +This Code of Conduct is adapted from the [Contributor Covenant][homepage], +version 2.1, available at +. + +Community Impact Guidelines were inspired by +[Mozilla's code of conduct enforcement ladder][https://github.com/mozilla/inclusion]. + +For answers to common questions about this code of conduct, see the FAQ at +. Translations are available at . + +[homepage]: https://www.contributor-covenant.org From 08cc3c2c5ca5f1308ba7bbd91acbe92a74ef25a7 Mon Sep 17 00:00:00 2001 From: Claudiu Forgaci Date: Tue, 17 Dec 2024 22:19:08 +0100 Subject: [PATCH 16/38] Add issue template --- .github/ISSUE_TEMPLATE/issue_template.md | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) create mode 100644 .github/ISSUE_TEMPLATE/issue_template.md diff --git a/.github/ISSUE_TEMPLATE/issue_template.md b/.github/ISSUE_TEMPLATE/issue_template.md new file mode 100644 index 0000000..d7c9eba --- /dev/null +++ b/.github/ISSUE_TEMPLATE/issue_template.md @@ -0,0 +1,16 @@ +--- +name: Bug report or feature request +about: Describe a bug you've seen or make a case for a new feature +--- + +Please briefly describe your problem and what output you expect. If you have a question, please don't use this form. Instead, ask on or . + +Please include a minimal reproducible example (AKA a reprex). If you've never heard of a [reprex](http://reprex.tidyverse.org/) before, start by reading . + +For more advice on how to write a great issue, see . + +Brief description of the problem + +```r +# insert reprex here +``` From 9a538c8b2d47a8d1c9d286daf9227b833b23f77d Mon Sep 17 00:00:00 2001 From: Claudiu Forgaci Date: Tue, 17 Dec 2024 22:45:25 +0100 Subject: [PATCH 17/38] Add PR template --- .github/PULL_REQUEST_TEMPLATE.md | 41 ++++++++++++++++++++++++++++++++ 1 file changed, 41 insertions(+) create mode 100644 .github/PULL_REQUEST_TEMPLATE.md diff --git a/.github/PULL_REQUEST_TEMPLATE.md b/.github/PULL_REQUEST_TEMPLATE.md new file mode 100644 index 0000000..d25cf84 --- /dev/null +++ b/.github/PULL_REQUEST_TEMPLATE.md @@ -0,0 +1,41 @@ + + +## What type of PR is this? (check all applicable) + +- [ ] Refactor +- [ ] Feature +- [ ] Bug Fix +- [ ] Optimization +- [ ] Documentation Update + +## Description + +## Related Issues + + + +- Related Issue # +- Closes # + +## Added/updated tests? +_We encourage you to keep the code coverage percentage at 75% and above._ + +- [ ] Yes +- [ ] No, and this is why: _please replace this line with details on why tests + have not been included_ +- [ ] I need help with writing tests + +## Added entry in changelog? +_For user-facing changes, add a line describing the changes in NEWS.md_ + +- [ ] Yes +![alt_text](gif_link) From c9431e9a3753c12382853f6f49f38290347d46ef Mon Sep 17 00:00:00 2001 From: Francesco Nattino Date: Wed, 18 Dec 2024 10:35:53 +0100 Subject: [PATCH 18/38] add segments tests --- tests/testthat/test-segments.R | 89 ++++++++++++++++++++++++++++++++++ 1 file changed, 89 insertions(+) create mode 100644 tests/testthat/test-segments.R diff --git a/tests/testthat/test-segments.R b/tests/testthat/test-segments.R new file mode 100644 index 0000000..966a279 --- /dev/null +++ b/tests/testthat/test-segments.R @@ -0,0 +1,89 @@ +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 + e3 <- sf::st_linestring(cbind(c(-2, -1.8), c(-1, 1))) # group 2 + e4 <- sf::st_linestring(cbind(c(-2, -2), c(-1, 1))) # group 2 <-- + e5 <- sf::st_linestring(cbind(c(-0.5, 0.5), c(-1, 1))) # group 3 <-- + e6 <- sf::st_linestring(cbind(c(0.5, -0.5), c(-1, 1))) # group 3 + e7 <- sf::st_linestring(cbind(c(1, 1), c(-1, 1))) # group 4 <-- + crossings <- sf::st_sfc(e1, e2, e3, e4, e5, e6, e7) + expected <- sf::st_sfc(e1, e4, e5, e7) + actual <- filter_clusters(crossings, river, eps = 0.2) + expect_setequal(expected, actual) +}) + +test_that("Candidate segments are properly refined", { + # A single solution is possible for each of the methods + p1 <- sf::st_polygon(list(cbind(c(-4, -4, -3, -3, -4), + c(-1, 1, 1, -1, -1)))) + p2 <- sf::st_polygon(list(cbind(c(-3, -3, -2, -2, -3), + c(0.9, 1, 1, 0.9, 0.9)))) + p3 <- sf::st_polygon(list(cbind(c(-3, -3, -2, -2, -3), + c(-1, 0.9, 0.9, -1, -1)))) + p4 <- sf::st_polygon(list(cbind(c(-2, -2, -1, -1, -2), + c(0.9, 1, 1, 0.9, 0.9)))) + p5 <- sf::st_polygon(list(cbind(c(-2, -2, -1, -1, -2), + c(-1, 0.9, 0.9, -1, -1)))) + p6 <- sf::st_polygon(list(cbind(c(-1, -1, 4, 4, -1), + c(-1, 1, 1, -1, -1)))) + blocks <- sf::st_sfc(p1, p2, p3, p4, p5, p6) + to_merge <- c(2, 4) + # p2 shares the longest intersection with p3, and p4 with p5 + expected_longest_intersection <- sf::st_sfc(p1, p6, + sf::st_union(p2, p3), + sf::st_union(p4, p5)) + 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)) + actual_smallest <- merge_blocks(blocks, to_merge, "smallest") + equals_longest_intersection <- sf::st_equals(actual_longest_intersection, + 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)), + \(x) equals_smallest[x, x]))) +}) + +test_that("Refinement works with equivalent options for merging", { + p1 <- sf::st_polygon(list(cbind(c(-4, -4, -3, -3, -4), + c(-1, 1, 1, -1, -1)))) + p2 <- sf::st_polygon(list(cbind(c(-3, -3, -2, -2, -3), + c(0, 1, 1, 0, 0)))) + p3 <- sf::st_polygon(list(cbind(c(-3, -3, -2, -2, -3), + c(-1, 0, 0, -1, -1)))) + p4 <- sf::st_polygon(list(cbind(c(-2, -2, -1, -1, -2), + c(0, 1, 1, 0, 0)))) + p5 <- sf::st_polygon(list(cbind(c(-2, -2, -1, -1, -2), + c(-1, 0, 0, -1, -1)))) + p6 <- sf::st_polygon(list(cbind(c(-1, -1, 4, 4, -1), + c(-1, 1, 1, -1, -1)))) + blocks <- sf::st_sfc(p1, p2, p3, p4, p5, p6) + to_merge <- c(2, 4) + # p2 shares intersections of the same length with p1, p3 and p4, + # it will thus be merged to the first element, i.e. p1. + # p4 shares intersections of the same length with p2, p5 and p6, + # After p2 is merged, the first neighbor in the list is p5. + expected_longest_intersection <- sf::st_sfc(p3, p6, + sf::st_union(p2, p1), + sf::st_union(p4, p5)) + actual_longest_intersection <- merge_blocks(blocks, to_merge, + "longest-intersection") + # p2's neighbours p3 and p4 have the same size, it will thus be merged + # to the first element, i.e. p3. + # p4's neighbours p2 and p5 have the same size, after p2 is merged with p3 + # the remaining smallest element is p5. + expected_smallest <- sf::st_sfc(p1, p6, + 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) + 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)), + \(x) equals_smallest[x, x]))) +}) From f91b3985250de3ecbf5157539be41b8252055769 Mon Sep 17 00:00:00 2001 From: Francesco Nattino Date: Wed, 18 Dec 2024 10:37:07 +0100 Subject: [PATCH 19/38] remove strokes interface to rcoins --- R/network.R | 24 ------------------------ R/segments.R | 9 ++++++--- man/get_segments.Rd | 3 ++- man/strokes.Rd | 28 ---------------------------- 4 files changed, 8 insertions(+), 56 deletions(-) delete mode 100644 man/strokes.Rd diff --git a/R/network.R b/R/network.R index e44a26c..29e7659 100644 --- a/R/network.R +++ b/R/network.R @@ -307,27 +307,3 @@ filter_network <- function(network, target) { tidygraph::activate("nodes") |> tidygraph::filter(sfnetworks::node_intersects(target)) } - -#' Identify naturally continuos lines in a spatial network. -#' -#' Extend the specified network edges along the spatial network to form longer -#' strokes. See [`rcoins::stroke()`] for more details. -#' -#' @param network A spatial network object -#' @param from_edge The indices of the network edges to be continued -#' @param angle_threshold Consecutive line segments are considered part of the -#' same continuous line if the internal angle they form is larger than -#' `angle_threshold`` (in degrees). Should be in the range [0, 180) degrees -#' @param flow_mode If TRUE, line segments that belong to the same edge are not -#' split across strokes (even if they form internal angles smaller than -#' `angle_threshold`). -#' -#' @return Stroke geometries as a simple feature object -strokes <- function( - network, from_edge, angle_threshold = 0., flow_mode = FALSE -) { - rcoins::stroke( - network, angle_threshold = angle_threshold, attributes = FALSE, - flow_mode = flow_mode, from_edge = from_edge - ) -} diff --git a/R/segments.R b/R/segments.R index 589c7c5..35d884e 100644 --- a/R/segments.R +++ b/R/segments.R @@ -7,7 +7,8 @@ #' @param network The spatial network to be used for the segmentation #' @param river_centerline The river centerline as a simple feature geometry #' @param angle_threshold Only consider angles above this threshold (in degrees) -#' to form continuous strokes in the network +#' to form continuous strokes in the network. See [`rcoins::stroke()`] for +#' more details. #' #' @return Segment polygons as a simple feature geometry #' @export @@ -16,7 +17,8 @@ get_segments <- function(corridor, network, river_centerline, # Find river crossings in the network and build continuous strokes from them crossings <- get_intersecting_edges(network, river_centerline) - crossing_strokes <- strokes(network, crossings, angle_threshold) + crossing_strokes <- rcoins::stroke(network, from_edge = crossings, + angle_threshold = angle_threshold) # Clip strokes and select the ones that could be used as segment boundaries block_edges <- clip_and_filter(crossing_strokes, corridor, river_centerline) @@ -154,7 +156,8 @@ filter_clusters <- function(crossings, river, eps = 100) { crossings_clustered$length <- sf::st_length(crossings_clustered) crossings_clustered |> dplyr::group_by(.data$cluster) |> - dplyr::filter(length == min(length)) + dplyr::filter(length == min(length) & !duplicated(length)) |> + sf::st_geometry() } #' Merge a set of blocks to adjacent ones diff --git a/man/get_segments.Rd b/man/get_segments.Rd index 36b4897..5140ed5 100644 --- a/man/get_segments.Rd +++ b/man/get_segments.Rd @@ -14,7 +14,8 @@ get_segments(corridor, network, river_centerline, angle_threshold = 90) \item{river_centerline}{The river centerline as a simple feature geometry} \item{angle_threshold}{Only consider angles above this threshold (in degrees) -to form continuous strokes in the network} +to form continuous strokes in the network. See \code{\link[rcoins:stroke]{rcoins::stroke()}} for +more details.} } \value{ Segment polygons as a simple feature geometry diff --git a/man/strokes.Rd b/man/strokes.Rd deleted file mode 100644 index 5690e86..0000000 --- a/man/strokes.Rd +++ /dev/null @@ -1,28 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/network.R -\name{strokes} -\alias{strokes} -\title{Identify naturally continuos lines in a spatial network.} -\usage{ -strokes(network, from_edge, angle_threshold = 0, flow_mode = FALSE) -} -\arguments{ -\item{network}{A spatial network object} - -\item{from_edge}{The indices of the network edges to be continued} - -\item{angle_threshold}{Consecutive line segments are considered part of the -same continuous line if the internal angle they form is larger than -`angle_threshold`` (in degrees). Should be in the range [0, 180) degrees} - -\item{flow_mode}{If TRUE, line segments that belong to the same edge are not -split across strokes (even if they form internal angles smaller than -\code{angle_threshold}).} -} -\value{ -Stroke geometries as a simple feature object -} -\description{ -Extend the specified network edges along the spatial network to form longer -strokes. See \code{\link[rcoins:stroke]{rcoins::stroke()}} for more details. -} From cfd29d8ab39105d3cb1e1331b1a5a829b64f5bf6 Mon Sep 17 00:00:00 2001 From: Claudiu Forgaci <33600128+cforgaci@users.noreply.github.com> Date: Wed, 18 Dec 2024 10:38:17 +0100 Subject: [PATCH 20/38] Apply suggestions from code review Co-authored-by: Francesco Nattino <49899980+fnattino@users.noreply.github.com> --- .github/PULL_REQUEST_TEMPLATE.md | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/.github/PULL_REQUEST_TEMPLATE.md b/.github/PULL_REQUEST_TEMPLATE.md index d25cf84..814f436 100644 --- a/.github/PULL_REQUEST_TEMPLATE.md +++ b/.github/PULL_REQUEST_TEMPLATE.md @@ -35,7 +35,6 @@ _We encourage you to keep the code coverage percentage at 75% and above._ - [ ] I need help with writing tests ## Added entry in changelog? -_For user-facing changes, add a line describing the changes in NEWS.md_ +_For user-facing changes, add a line describing the changes in [NEWS.md](/NEWS.md)_ - [ ] Yes -![alt_text](gif_link) From 19ef767950e5cff5ef06813f9d25a9df6b600a77 Mon Sep 17 00:00:00 2001 From: Claudiu Forgaci Date: Wed, 18 Dec 2024 10:44:46 +0100 Subject: [PATCH 21/38] Add NEWS.md --- NEWS.md | 6 ++++++ 1 file changed, 6 insertions(+) create mode 100644 NEWS.md diff --git a/NEWS.md b/NEWS.md new file mode 100644 index 0000000..c10dc28 --- /dev/null +++ b/NEWS.md @@ -0,0 +1,6 @@ +All notable changes to this project will be documented in this file. + +The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.1.0/), +and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html). + +# [Unreleased] From dd22ddb4711cf2303e1057de1b86c80385d2155e Mon Sep 17 00:00:00 2001 From: Claudiu Forgaci Date: Wed, 18 Dec 2024 10:54:42 +0100 Subject: [PATCH 22/38] Add reference to contributing and coc in README --- README.Rmd | 6 ++++++ README.md | 9 +++++++++ 2 files changed, 15 insertions(+) diff --git a/README.Rmd b/README.Rmd index 7edca44..6a16e4d 100644 --- a/README.Rmd +++ b/README.Rmd @@ -38,3 +38,9 @@ This is a basic example which shows you how to solve a common problem: library(CRiSp) ## basic example code ``` + +## Contributing + +We look very much forward to contributions to the package. See the [Contributing Guide](.github/CONTRIBUTING.md) for further details. + +This package is released with a [Contributor Code of Conduct](.github/CODE_OF_CONDUCT.md). By contributing to this project you agree to abide by its terms. diff --git a/README.md b/README.md index e9334f7..b30bd66 100644 --- a/README.md +++ b/README.md @@ -29,3 +29,12 @@ This is a basic example which shows you how to solve a common problem: library(CRiSp) ## basic example code ``` + +## Contributing + +We look very much forward to contributions to the package. See the +[Contributing Guide](.github/CONTRIBUTING.md) for further details. + +This package is released with a [Contributor Code of +Conduct](.github/CODE_OF_CONDUCT.md). By contributing to this project +you agree to abide by its terms. From 787d1f341f2080dd3918ed9381030baee746db6b Mon Sep 17 00:00:00 2001 From: Claudiu Forgaci Date: Wed, 18 Dec 2024 10:54:53 +0100 Subject: [PATCH 23/38] Add NEWS.md --- NEWS.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/NEWS.md b/NEWS.md index c10dc28..005f929 100644 --- a/NEWS.md +++ b/NEWS.md @@ -4,3 +4,5 @@ The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.1.0/), and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html). # [Unreleased] + +- Add developer guidelines From c476d1e53e066e7b0c363da5fe11df3678c7f80f Mon Sep 17 00:00:00 2001 From: Francesco Nattino <49899980+fnattino@users.noreply.github.com> Date: Thu, 19 Dec 2024 10:45:34 +0100 Subject: [PATCH 24/38] Update R/segments.R Co-authored-by: Claudiu Forgaci <33600128+cforgaci@users.noreply.github.com> --- R/segments.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/segments.R b/R/segments.R index 35d884e..7219a07 100644 --- a/R/segments.R +++ b/R/segments.R @@ -31,7 +31,7 @@ get_segments <- function(corridor, network, river_centerline, refine_segments(blocks, river_centerline, corridor) } -#' Identify network edges that are intersecting a geometry. +#' Identify network edges that are intersecting a geometry #' #' @param network A spatial network object #' @param geometry A simple feature geometry From 8b704817970987315059ece9d6cb7bfbb3dd6624 Mon Sep 17 00:00:00 2001 From: Francesco Nattino Date: Thu, 19 Dec 2024 10:50:00 +0100 Subject: [PATCH 25/38] how -> method --- R/segments.R | 26 +++++++++++++------------- 1 file changed, 13 insertions(+), 13 deletions(-) diff --git a/R/segments.R b/R/segments.R index 7219a07..7fb5bbb 100644 --- a/R/segments.R +++ b/R/segments.R @@ -110,7 +110,7 @@ refine_segments <- function(blocks, river_centerline, corridor) { idx_not_instersects_river <- not_intersect_river(blocks) if (length(idx_not_instersects_river) == 0) break blocks <- merge_blocks(blocks, idx_not_instersects_river, - how = "longest-intersection") + method = "longest-intersection") } # Recursively merge blocks until all blocks intersect both edges @@ -124,7 +124,7 @@ refine_segments <- function(blocks, river_centerline, corridor) { idx_not_intersect_both_edges <- not_intersect_both_edges(blocks) if (length(idx_not_intersect_both_edges) == 0) break blocks <- merge_blocks(blocks, idx_not_intersect_both_edges, - how = "smallest") + method = "smallest") } return(blocks) } @@ -169,10 +169,10 @@ filter_clusters <- function(crossings, river, eps = 100) { #' #' @param blocks Simple feature geometry representing all the blocks #' @param to_merge Indices of the blocks to merge -#' @param how Strategy for merging, see [merge_block()] +#' @param method Strategy for merging, see [merge_block()] #' #' @return Blocks merged to the specified ones as a simple feature geometry -merge_blocks <- function(blocks, to_merge, how = "longest-intersection") { +merge_blocks <- function(blocks, to_merge, method = "longest-intersection") { if (length(to_merge) == 0) { return(blocks) } @@ -186,34 +186,34 @@ merge_blocks <- function(blocks, to_merge, how = "longest-intersection") { idx_others <- to_merge[!seq_along(to_merge) %in% idx_smallest] others <- blocks[idx_others] # Merge current block with one of the targets - merged <- merge_block(targets, current, how = how) + merged <- merge_block(targets, current, method = method) # Determine the new indices of the other blocks that need to be merged is_equal <- sf::st_equals(merged, others, sparse = TRUE) idx_others <- which(apply(is_equal, any, MARGIN = 1)) # Continue merging other blocks, recursively - merge_blocks(blocks = merged, to_merge = idx_others, how = how) + merge_blocks(blocks = merged, to_merge = idx_others, method = method) } #' Merge a block to one of the target geometries #' #' @param targets Sequence of target blocks as a simple feature geometry #' @param block Block to merge as a simple feature geometry -#' @param how Strategy for merging, choose between "smallest" (merge to smallest -#' adjacent block) and "longest-intersection" (merge to block which it shares -#' the longest intersection with) +#' @param method Strategy for merging, choose between "smallest" (merge to +#' smallest adjacent block) and "longest-intersection" (merge to block which +#' it shares the longest intersection with) #' #' @return Blocks merged to the specified one as a simple feature geometry -merge_block <- function(targets, block, how = "longest-intersection") { +merge_block <- function(targets, block, method = "longest-intersection") { idx_adjacent <- find_adjacent(targets, block) - if (how == "longest-intersection") { + if (method == "longest-intersection") { intersections <- sf::st_intersection(targets[idx_adjacent], block) idx_longest_intersection <- find_longest(intersections) idx_to_merge <- idx_adjacent[idx_longest_intersection] - } else if (how == "smallest") { + } else if (method == "smallest") { idx_smallest <- find_smallest(targets[idx_adjacent]) idx_to_merge <- idx_adjacent[idx_smallest] } else { - stop(sprintf("Method '%s' unknown", how)) + stop(sprintf("Method '%s' unknown", method)) } merged <- sf::st_union(targets[idx_to_merge], block) others <- targets[!seq_along(targets) %in% idx_to_merge] From 760b0bbcbc46787746b977f45e9d322a49478da6 Mon Sep 17 00:00:00 2001 From: Francesco Nattino <49899980+fnattino@users.noreply.github.com> Date: Thu, 19 Dec 2024 10:51:33 +0100 Subject: [PATCH 26/38] Update R/segments.R Co-authored-by: Claudiu Forgaci <33600128+cforgaci@users.noreply.github.com> --- R/segments.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/segments.R b/R/segments.R index 7fb5bbb..f6eaa58 100644 --- a/R/segments.R +++ b/R/segments.R @@ -107,7 +107,7 @@ refine_segments <- function(blocks, river_centerline, corridor) { idx[!idx %in% idx_instersect_river] } while (TRUE) { - idx_not_instersects_river <- not_intersect_river(blocks) + idx_not_instersects_river <- not_intersect_river(blocks = blocks) if (length(idx_not_instersects_river) == 0) break blocks <- merge_blocks(blocks, idx_not_instersects_river, method = "longest-intersection") From 146b83e58f4a13b79f9d5f4aa0aaf140d5b06544 Mon Sep 17 00:00:00 2001 From: Francesco Nattino Date: Thu, 19 Dec 2024 13:24:21 +0100 Subject: [PATCH 27/38] reorder auxiliary functions according to call order --- R/segments.R | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/R/segments.R b/R/segments.R index f6eaa58..45a3551 100644 --- a/R/segments.R +++ b/R/segments.R @@ -226,6 +226,15 @@ find_smallest <- function(geometry) { return(which.min(area)) } +#' @noRd +find_adjacent <- function(geometry, target) { + idx_neighbour <- find_intersects(geometry, target) + intersections <- sf::st_intersection(geometry[idx_neighbour], target) + is_adjacent_intersections <- sf::st_is(intersections, + c("MULTILINESTRING", "LINESTRING")) + return(idx_neighbour[is_adjacent_intersections]) +} + #' @noRd find_longest <- function(geometry) { length <- sf::st_length(geometry) @@ -237,12 +246,3 @@ find_intersects <- function(geometry, target) { instersects <- sf::st_intersects(geometry, target, sparse = FALSE) return(which(instersects)) } - -#' @noRd -find_adjacent <- function(geometry, target) { - idx_neighbour <- find_intersects(geometry, target) - intersections <- sf::st_intersection(geometry[idx_neighbour], target) - is_adjacent_intersections <- sf::st_is(intersections, - c("MULTILINESTRING", "LINESTRING")) - return(idx_neighbour[is_adjacent_intersections]) -} From 40d6bc697101651e70c3e21b7328d8a70e57f16a Mon Sep 17 00:00:00 2001 From: Francesco Nattino Date: Thu, 19 Dec 2024 13:29:41 +0100 Subject: [PATCH 28/38] idx -> index --- R/segments.R | 65 ++++++++++++++++++++++++++-------------------------- 1 file changed, 33 insertions(+), 32 deletions(-) diff --git a/R/segments.R b/R/segments.R index 45a3551..a0efe92 100644 --- a/R/segments.R +++ b/R/segments.R @@ -102,28 +102,29 @@ refine_segments <- function(blocks, river_centerline, corridor) { # Recursively merge blocks until all blocks intersect the river not_intersect_river <- function(blocks) { - idx_instersect_river <- find_intersects(blocks, river_centerline) - idx <- seq_along(blocks) - idx[!idx %in% idx_instersect_river] + index_instersect_river <- find_intersects(blocks, river_centerline) + index <- seq_along(blocks) + index[!index %in% index_instersect_river] } while (TRUE) { - idx_not_instersects_river <- not_intersect_river(blocks = blocks) - if (length(idx_not_instersects_river) == 0) break - blocks <- merge_blocks(blocks, idx_not_instersects_river, + index_not_instersects_river <- not_intersect_river(blocks = blocks) + if (length(index_not_instersects_river) == 0) break + blocks <- merge_blocks(blocks, index_not_instersects_river, method = "longest-intersection") } # Recursively merge blocks until all blocks intersect both edges not_intersect_both_edges <- function(blocks) { - idx_intersects_edge_1 <- find_intersects(blocks, corridor_edges[1]) - idx_intersects_edge_2 <- find_intersects(blocks, corridor_edges[2]) - idx <- seq_along(blocks) - idx[!(idx %in% idx_intersects_edge_1 & idx %in% idx_intersects_edge_2)] + index_intersects_edge_1 <- find_intersects(blocks, corridor_edges[1]) + index_intersects_edge_2 <- find_intersects(blocks, corridor_edges[2]) + index <- seq_along(blocks) + index[!(index %in% index_intersects_edge_1 & + index %in% index_intersects_edge_2)] } while (TRUE) { - idx_not_intersect_both_edges <- not_intersect_both_edges(blocks) - if (length(idx_not_intersect_both_edges) == 0) break - blocks <- merge_blocks(blocks, idx_not_intersect_both_edges, + index_not_intersect_both_edges <- not_intersect_both_edges(blocks) + if (length(index_not_intersect_both_edges) == 0) break + blocks <- merge_blocks(blocks, index_not_intersect_both_edges, method = "smallest") } return(blocks) @@ -177,21 +178,21 @@ merge_blocks <- function(blocks, to_merge, method = "longest-intersection") { return(blocks) } # Pick the first block to merge, i.e. the smallest one, and the targets - idx_smallest <- find_smallest(blocks[to_merge]) - idx_current <- to_merge[idx_smallest] - current <- blocks[idx_current] - targets <- blocks[!seq_along(blocks) %in% idx_current] + index_smallest <- find_smallest(blocks[to_merge]) + index_current <- to_merge[index_smallest] + current <- blocks[index_current] + targets <- blocks[!seq_along(blocks) %in% index_current] # Keep track of the geometries of the blocks that still need merging: their # position in the list of blocks might change after merging the current one! - idx_others <- to_merge[!seq_along(to_merge) %in% idx_smallest] - others <- blocks[idx_others] + index_others <- to_merge[!seq_along(to_merge) %in% index_smallest] + others <- blocks[index_others] # Merge current block with one of the targets merged <- merge_block(targets, current, method = method) # Determine the new indices of the other blocks that need to be merged is_equal <- sf::st_equals(merged, others, sparse = TRUE) - idx_others <- which(apply(is_equal, any, MARGIN = 1)) + index_others <- which(apply(is_equal, any, MARGIN = 1)) # Continue merging other blocks, recursively - merge_blocks(blocks = merged, to_merge = idx_others, method = method) + merge_blocks(blocks = merged, to_merge = index_others, method = method) } #' Merge a block to one of the target geometries @@ -204,19 +205,19 @@ merge_blocks <- function(blocks, to_merge, method = "longest-intersection") { #' #' @return Blocks merged to the specified one as a simple feature geometry merge_block <- function(targets, block, method = "longest-intersection") { - idx_adjacent <- find_adjacent(targets, block) + index_adjacent <- find_adjacent(targets, block) if (method == "longest-intersection") { - intersections <- sf::st_intersection(targets[idx_adjacent], block) - idx_longest_intersection <- find_longest(intersections) - idx_to_merge <- idx_adjacent[idx_longest_intersection] + intersections <- sf::st_intersection(targets[index_adjacent], block) + index_longest_intersection <- find_longest(intersections) + index_to_merge <- index_adjacent[index_longest_intersection] } else if (method == "smallest") { - idx_smallest <- find_smallest(targets[idx_adjacent]) - idx_to_merge <- idx_adjacent[idx_smallest] + index_smallest <- find_smallest(targets[index_adjacent]) + index_to_merge <- index_adjacent[index_smallest] } else { stop(sprintf("Method '%s' unknown", method)) } - merged <- sf::st_union(targets[idx_to_merge], block) - others <- targets[!seq_along(targets) %in% idx_to_merge] + merged <- sf::st_union(targets[index_to_merge], block) + others <- targets[!seq_along(targets) %in% index_to_merge] return(c(others, merged)) } @@ -228,11 +229,11 @@ find_smallest <- function(geometry) { #' @noRd find_adjacent <- function(geometry, target) { - idx_neighbour <- find_intersects(geometry, target) - intersections <- sf::st_intersection(geometry[idx_neighbour], 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(idx_neighbour[is_adjacent_intersections]) + return(index_neighbour[is_adjacent_intersections]) } #' @noRd From 7ed97f0c7902721805e9095f7831cca47777a423 Mon Sep 17 00:00:00 2001 From: Francesco Nattino <49899980+fnattino@users.noreply.github.com> Date: Thu, 19 Dec 2024 13:30:22 +0100 Subject: [PATCH 29/38] Update vignettes/corridor-segmentation.Rmd Co-authored-by: Claudiu Forgaci <33600128+cforgaci@users.noreply.github.com> --- vignettes/corridor-segmentation.Rmd | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/vignettes/corridor-segmentation.Rmd b/vignettes/corridor-segmentation.Rmd index 978abc9..f07f74f 100644 --- a/vignettes/corridor-segmentation.Rmd +++ b/vignettes/corridor-segmentation.Rmd @@ -20,7 +20,7 @@ library(CRiSp) For a more detailed analysis of an urban river corridor, corridor-level delineation may not be sufficient. The corridor needs to be subdivided into smaller morphological units. Segmentation is a process of subdividing the corridor by using major transversal road or rail infrastructure lines. -By default, the all-in-one function `delineate_corridor()` includes the division of the corridor into segments. It is also possible to use the `get_segments()` function to divide the corridor in a separate step. +By default, the all-in-one function `delineate_corridor()` only returns the corridor boundary. The corridor can be segmented either by setting the argument `segments = TRUE` in `delineate_corridor()` or by using the `get_segments()` function in a separate step. To demonstrate this as a separate step, we will use the `bucharest_osm$corridor` and `bucharest_osm$streets` layers from the package data as input. From 20aa494914ac54945d9ddec332431f077018c2c1 Mon Sep 17 00:00:00 2001 From: Francesco Nattino <49899980+fnattino@users.noreply.github.com> Date: Thu, 19 Dec 2024 13:30:41 +0100 Subject: [PATCH 30/38] Update vignettes/corridor-segmentation.Rmd Co-authored-by: Claudiu Forgaci <33600128+cforgaci@users.noreply.github.com> --- vignettes/corridor-segmentation.Rmd | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/vignettes/corridor-segmentation.Rmd b/vignettes/corridor-segmentation.Rmd index f07f74f..3f77c2f 100644 --- a/vignettes/corridor-segmentation.Rmd +++ b/vignettes/corridor-segmentation.Rmd @@ -22,7 +22,7 @@ For a more detailed analysis of an urban river corridor, corridor-level delineat By default, the all-in-one function `delineate_corridor()` only returns the corridor boundary. The corridor can be segmented either by setting the argument `segments = TRUE` in `delineate_corridor()` or by using the `get_segments()` function in a separate step. -To demonstrate this as a separate step, we will use the `bucharest_osm$corridor` and `bucharest_osm$streets` layers from the package data as input. +To demonstrate this as a separate step, we will use the `bucharest_osm$corridor`, `bucharest_osm$streets` and `bucharest_osm$railways` layers from the package data as input. We first prepare the network and select all the streets and railways that cover the river corridor plus a small buffer region (see also `vignette("network-preparation")`): From eb2f6370b1123873e5321e32a6c714a54dbaf6c8 Mon Sep 17 00:00:00 2001 From: Francesco Nattino <49899980+fnattino@users.noreply.github.com> Date: Thu, 19 Dec 2024 13:31:00 +0100 Subject: [PATCH 31/38] Update vignettes/corridor-segmentation.Rmd Co-authored-by: Claudiu Forgaci <33600128+cforgaci@users.noreply.github.com> --- vignettes/corridor-segmentation.Rmd | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/vignettes/corridor-segmentation.Rmd b/vignettes/corridor-segmentation.Rmd index 3f77c2f..f797988 100644 --- a/vignettes/corridor-segmentation.Rmd +++ b/vignettes/corridor-segmentation.Rmd @@ -29,7 +29,7 @@ We first prepare the network and select all the streets and railways that cover ```{r eval=FALSE} # TODO remove eval=FALSE when the corridor is available as packaged data # Build combined street and railway network -network <- bind_rows(streets, railways) |> +network <- bind_rows(bucharest_osm$streets, bucharest_orsm$railways) |> as_sfnetwork(directed = FALSE) # Add a 100 meter buffer region to the corridor From 8bf643d3c7d9b10666da34d13fa5c495afa99930 Mon Sep 17 00:00:00 2001 From: Francesco Nattino Date: Thu, 19 Dec 2024 13:36:51 +0100 Subject: [PATCH 32/38] corridor will be added to bucharest_delineation packaged data --- vignettes/corridor-segmentation.Rmd | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/vignettes/corridor-segmentation.Rmd b/vignettes/corridor-segmentation.Rmd index 978abc9..aa5964e 100644 --- a/vignettes/corridor-segmentation.Rmd +++ b/vignettes/corridor-segmentation.Rmd @@ -43,7 +43,7 @@ We then delineate segments in the corridor. The algorithm spits the corridor usi ```{r eval=FALSE} # TODO remove eval=FALSE when the corridor is available as packaged data -segmented_corridor <- get_segments(bucharest_osm$corridor, +segmented_corridor <- get_segments(bucharest_delineation$corridor, network_filtered) ``` From da626af6ef83f71a1b5421fc5c26121ea88e2c1f Mon Sep 17 00:00:00 2001 From: Francesco Nattino Date: Thu, 19 Dec 2024 13:46:29 +0100 Subject: [PATCH 33/38] reorder according to call order --- R/segments.R | 62 ++++++++++++++++++++++++++-------------------------- 1 file changed, 31 insertions(+), 31 deletions(-) diff --git a/R/segments.R b/R/segments.R index a0efe92..2e674b6 100644 --- a/R/segments.R +++ b/R/segments.R @@ -85,6 +85,37 @@ 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. +#' +#' 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 +#' edges representing e.g. different lanes of the same street are treated as +#' part of the same crossing. For each cluster, select the shortest edge. +#' +#' @param crossings Crossing edge geometries as a simple feature object +#' @param river The river geometry as a simple feature object +#' @param eps DBSCAN parameter referring to the size (radius) distance of the +#' neighborhood. Should approximate the distance between edges that we want +#' to consider as a single river crossing +#' +#' @return A simple feature geometry including the shortest edge per cluster +filter_clusters <- function(crossings, river, eps = 100) { + intersections <- sf::st_intersection(crossings, river) + # By computing centroids we make sure we only have POINT geometries here + intersections_centroids <- sf::st_centroid(intersections) + intersections_coords <- sf::st_coordinates(intersections_centroids) + # We should not enforce a min mumber of elements - one-element clusters are OK + db <- dbscan::dbscan(intersections_coords, eps = eps, minPts = 1) + + crossings_clustered <- sf::st_as_sf(crossings) + crossings_clustered$cluster <- db$cluster + crossings_clustered$length <- sf::st_length(crossings_clustered) + crossings_clustered |> + dplyr::group_by(.data$cluster) |> + dplyr::filter(length == min(length) & !duplicated(length)) |> + sf::st_geometry() +} + #' Refine candidate segments via recursive merging #' #' Recursively merge the candidate segments provided ("blocks"), until they all @@ -130,37 +161,6 @@ refine_segments <- function(blocks, river_centerline, corridor) { return(blocks) } -#' 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 -#' edges representing e.g. different lanes of the same street are treated as -#' part of the same crossing. For each cluster, select the shortest edge. -#' -#' @param crossings Crossing edge geometries as a simple feature object -#' @param river The river geometry as a simple feature object -#' @param eps DBSCAN parameter referring to the size (radius) distance of the -#' neighborhood. Should approximate the distance between edges that we want -#' to consider as a single river crossing -#' -#' @return A simple feature geometry including the shortest edge per cluster -filter_clusters <- function(crossings, river, eps = 100) { - intersections <- sf::st_intersection(crossings, river) - # By computing centroids we make sure we only have POINT geometries here - intersections_centroids <- sf::st_centroid(intersections) - intersections_coords <- sf::st_coordinates(intersections_centroids) - # We should not enforce a min mumber of elements - one-element clusters are OK - db <- dbscan::dbscan(intersections_coords, eps = eps, minPts = 1) - - crossings_clustered <- sf::st_as_sf(crossings) - crossings_clustered$cluster <- db$cluster - crossings_clustered$length <- sf::st_length(crossings_clustered) - crossings_clustered |> - dplyr::group_by(.data$cluster) |> - dplyr::filter(length == min(length) & !duplicated(length)) |> - sf::st_geometry() -} - #' Merge a set of blocks to adjacent ones #' #' Adjacent blocks are defined as the blocks that are neighbours to the blocks From f8619c6755a8a0c4800dd1b511124b87c9ff1546 Mon Sep 17 00:00:00 2001 From: Francesco Nattino Date: Thu, 19 Dec 2024 14:43:29 +0100 Subject: [PATCH 34/38] small refactoring --- R/corridor.R | 31 ------------------ R/network.R | 18 +++++++++++ R/segments.R | 42 ++---------------------- R/sf.R | 59 ++++++++++++++++++++++++++++++++++ tests/testthat/test-corridor.R | 18 ----------- tests/testthat/test-sf.R | 17 ++++++++++ 6 files changed, 96 insertions(+), 89 deletions(-) create mode 100644 R/sf.R create mode 100644 tests/testthat/test-sf.R diff --git a/R/corridor.R b/R/corridor.R index 7287084..b61068d 100644 --- a/R/corridor.R +++ b/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() -} diff --git a/R/network.R b/R/network.R index 29e7659..938b4f2 100644 --- a/R/network.R +++ b/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, ]) + } +} diff --git a/R/segments.R b/R/segments.R index 2e674b6..6d1e725 100644 --- a/R/segments.R +++ b/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)) -} diff --git a/R/sf.R b/R/sf.R new file mode 100644 index 0000000..31e46b0 --- /dev/null +++ b/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) + } +} \ No newline at end of file diff --git a/tests/testthat/test-corridor.R b/tests/testthat/test-corridor.R index 26efdba..1b5e00d 100644 --- a/tests/testthat/test-corridor.R +++ b/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", { # ____________ # | | diff --git a/tests/testthat/test-sf.R b/tests/testthat/test-sf.R new file mode 100644 index 0000000..0aeab15 --- /dev/null +++ b/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) +}) \ No newline at end of file From 51ff182a22ade424fe06de371b359768f1f86881 Mon Sep 17 00:00:00 2001 From: Francesco Nattino Date: Thu, 19 Dec 2024 14:43:46 +0100 Subject: [PATCH 35/38] fix tests segments --- tests/testthat/test-segments.R | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/tests/testthat/test-segments.R b/tests/testthat/test-segments.R index 966a279..29f000c 100644 --- a/tests/testthat/test-segments.R +++ b/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)), From 19f5585f1286aa8c20e25793d45d1c8f19d645f3 Mon Sep 17 00:00:00 2001 From: Francesco Nattino Date: Thu, 19 Dec 2024 14:44:53 +0100 Subject: [PATCH 36/38] update docs --- man/filter_clusters.Rd | 2 +- man/get_intersecting_edges.Rd | 13 ++++++++----- man/merge_block.Rd | 8 ++++---- man/merge_blocks.Rd | 4 ++-- man/split.Rd | 2 +- 5 files changed, 16 insertions(+), 13 deletions(-) diff --git a/man/filter_clusters.Rd b/man/filter_clusters.Rd index c1f6dbc..afb2add 100644 --- a/man/filter_clusters.Rd +++ b/man/filter_clusters.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/segments.R \name{filter_clusters} \alias{filter_clusters} -\title{Cluster the river crossings and select the shortest crossing per cluster.} +\title{Cluster the river crossings and select the shortest crossing per cluster} \usage{ filter_clusters(crossings, river, eps = 100) } diff --git a/man/get_intersecting_edges.Rd b/man/get_intersecting_edges.Rd index 8217842..18ab8f2 100644 --- a/man/get_intersecting_edges.Rd +++ b/man/get_intersecting_edges.Rd @@ -1,19 +1,22 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/segments.R +% Please edit documentation in R/network.R \name{get_intersecting_edges} \alias{get_intersecting_edges} -\title{Identify network edges that are intersecting a geometry.} +\title{Identify network edges that are intersecting a geometry} \usage{ -get_intersecting_edges(network, geometry) +get_intersecting_edges(network, geometry, index = FALSE) } \arguments{ \item{network}{A spatial network object} \item{geometry}{A simple feature geometry} + +\item{index}{Whether to return the indices of the matchin edges or the +geometries} } \value{ -Indices of the edges intersecting the geometry as a vector +Indices or geometries of the edges intersecting the given geometry } \description{ -Identify network edges that are intersecting a geometry. +Identify network edges that are intersecting a geometry } diff --git a/man/merge_block.Rd b/man/merge_block.Rd index d8047c2..2c37fb4 100644 --- a/man/merge_block.Rd +++ b/man/merge_block.Rd @@ -4,16 +4,16 @@ \alias{merge_block} \title{Merge a block to one of the target geometries} \usage{ -merge_block(targets, block, how = "longest-intersection") +merge_block(targets, block, method = "longest-intersection") } \arguments{ \item{targets}{Sequence of target blocks as a simple feature geometry} \item{block}{Block to merge as a simple feature geometry} -\item{how}{Strategy for merging, choose between "smallest" (merge to smallest -adjacent block) and "longest-intersection" (merge to block which it shares -the longest intersection with)} +\item{method}{Strategy for merging, choose between "smallest" (merge to +smallest adjacent block) and "longest-intersection" (merge to block which +it shares the longest intersection with)} } \value{ Blocks merged to the specified one as a simple feature geometry diff --git a/man/merge_blocks.Rd b/man/merge_blocks.Rd index 563ebb7..7ed7919 100644 --- a/man/merge_blocks.Rd +++ b/man/merge_blocks.Rd @@ -4,14 +4,14 @@ \alias{merge_blocks} \title{Merge a set of blocks to adjacent ones} \usage{ -merge_blocks(blocks, to_merge, how = "longest-intersection") +merge_blocks(blocks, to_merge, method = "longest-intersection") } \arguments{ \item{blocks}{Simple feature geometry representing all the blocks} \item{to_merge}{Indices of the blocks to merge} -\item{how}{Strategy for merging, see \code{\link[=merge_block]{merge_block()}}} +\item{method}{Strategy for merging, see \code{\link[=merge_block]{merge_block()}}} } \value{ Blocks merged to the specified ones as a simple feature geometry diff --git a/man/split.Rd b/man/split.Rd index 2ffaa76..ef49d4a 100644 --- a/man/split.Rd +++ b/man/split.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/corridor.R +% Please edit documentation in R/sf.R \name{split} \alias{split} \title{Split a geometry along a (multi)linestring.} From 5b6f9e51fe6f420d0eaad6f225ca1749887d6606 Mon Sep 17 00:00:00 2001 From: Francesco Nattino Date: Thu, 19 Dec 2024 14:51:49 +0100 Subject: [PATCH 37/38] fix link in docstring --- R/delineate.R | 2 +- man/delineate_corridor.Rd | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/delineate.R b/R/delineate.R index 88a2235..f50bf3d 100644 --- a/R/delineate.R +++ b/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 #' diff --git a/man/delineate_corridor.Rd b/man/delineate_corridor.Rd index 833ab6a..3d979af 100644 --- a/man/delineate_corridor.Rd +++ b/man/delineate_corridor.Rd @@ -36,7 +36,7 @@ the available methods} \item{angle_threshold}{Only network edges forming angles above this threshold (in degrees) are considered when forming segment edges. See -\verb{[get_segments()]} and \code{\link[=strokes]{strokes()}}. Only used if \code{segments} is TRUE.} +\code{\link[=get_segments]{get_segments()}} and \code{\link[rcoins:stroke]{rcoins::stroke()}}. Only used if \code{segments} is TRUE.} \item{segments}{Whether to carry out the corridor segmentation} From 18d53e49c13425c17b12a90d589af1b879f858e3 Mon Sep 17 00:00:00 2001 From: Francesco Nattino Date: Thu, 19 Dec 2024 14:55:02 +0100 Subject: [PATCH 38/38] fix lint issues --- R/sf.R | 2 +- tests/testthat/test-sf.R | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/sf.R b/R/sf.R index 31e46b0..e22ee63 100644 --- a/R/sf.R +++ b/R/sf.R @@ -56,4 +56,4 @@ split <- function(geometry, line, boundary = FALSE) { split_boundary <- sf::st_difference(boundaries, line) return(split_boundary) } -} \ No newline at end of file +} diff --git a/tests/testthat/test-sf.R b/tests/testthat/test-sf.R index 0aeab15..fdf713b 100644 --- a/tests/testthat/test-sf.R +++ b/tests/testthat/test-sf.R @@ -14,4 +14,4 @@ test_that("Splitting a geometry by a complex line still returns two edges", { c(-1, 1, 1, -1, -1))))) edges <- split(geometry, line, boundary = TRUE) expect_equal(length(edges), 2) -}) \ No newline at end of file +})