Add new vignette on merging nets

.Rbuildignore

@@ -19,3 +19,4 @@ log-latest
 ^\.github/workflows/pr-commands\.yaml$
 ^\.github$
 ^CRAN-SUBMISSION$
+.geojson

NAMESPACE

@@ -87,6 +87,7 @@ export(rnet_boundary_points)
 export(rnet_boundary_points_lwgeom)
 export(rnet_boundary_unique)
 export(rnet_breakup_vertices)
+export(rnet_connected)
 export(rnet_duplicated_vertices)
 export(rnet_get_nodes)
 export(rnet_group)

R/rnet_group.R

@@ -102,3 +102,27 @@ rnet_group.sf <- function(
     ...
   )
 }
+
+#' Keep only segments connected to the largest group in a network
+#'
+#' This function takes an sf object representing a road network and
+#' returns only the parts of the network that are in the largest group.
+#'
+#' @param rnet An sf object representing a road network
+#' @return An sf object representing the largest group in the network
+#' @export
+#' @examples
+#' rnet <- rnet_breakup_vertices(stplanr::osm_net_example)
+#' rnet_largest_group <- rnet_connected(rnet)
+#' plot(rnet$geometry)
+#' plot(rnet_largest_group$geometry)
+rnet_connected <- function(rnet) {
+  # Only proceed if igraph installed:
+  if (!requireNamespace("igraph", quietly = TRUE)) {
+    message("You must install igraph for this function to work")
+  } else {
+      mem <- rnet_group(rnet)
+      rnet <- rnet[mem == which.max(table(mem)), ]
+  }
+  rnet
+}

R/rnet_join.R

@@ -99,24 +99,26 @@ rnet_join = function(rnet_x, rnet_y, dist = 5, length_y = TRUE, key_column = 1,
 #' @param rnet_y The subsetting route network
 #' @param dist The buffer width around y in meters. 1 m by default.
 #' @param crop Crop `rnet_x`? `TRUE` is the default
-#' @param min_x Segments shorter than this multiple of dist
+#' @param min_length Segments shorter than this multiple of dist
 #'   *and* which were longer
 #'   before the cropping process will be removed. 3 by default.
+#' @param rm_disconnected Remove ways that are
 #' @export
-rnet_subset = function(rnet_x, rnet_y, dist = 10, crop = TRUE, min_x = 3) {
+rnet_subset = function(rnet_x, rnet_y, dist = 10, crop = TRUE, min_length = 0, rm_disconnected = TRUE) {
   rnet_x$length_x_original = as.numeric(sf::st_length(rnet_x))
   rnet_y_union = sf::st_union(rnet_y)
   rnet_y_buffer = stplanr::geo_buffer(rnet_y_union, dist = dist, nQuadSegs = 2)
   if(crop) {
     rnet_x = sf::st_intersection(rnet_x, rnet_y_buffer)
     rnet_x = line_cast(rnet_x)
-    rnet_x$length_x_cropped = as.numeric(sf::st_length(rnet_x))
-    min_length = dist * min_x
-    sel_short = rnet_x$length_x_cropped < min_length &
-      rnet_x$length_x_original > min_length
-    rnet_x = rnet_x[!sel_short, ]
   } else {
-    rnet_x[rnet_y_buffer, , op = sf::st_within]
+    rnet_x = rnet_x[rnet_y_buffer, , op = sf::st_within]
+  }
+  if(min_length > 0) {
+    rnet_x = rnet_x[as.numeric(sf::st_length(rnet_x)) > min_length]
+  }
+  if(rm_disconnected) {
+    rnet_x = rnet_connected(rnet_x)
   }
   rnet_x
 }
@@ -156,11 +158,10 @@ line_cast = function(x) {
 #' system("gh release list")
 #' system("gh release upload v1.0.2 rnet_*")
 #' # List the files released in v1.0.2:
-#' system("gh release download v1.0.2")
-#' rnet_x = sf::read_sf("rnet_x_ed.geojson")
-#' rnet_y = sf::read_sf("rnet_y_ed.geojson")
-#'
-#' rnet_merged = rnet_merge(rnet_x, rnet_y, dist = 9, segment_length = 20, funs = funs)
+#' # system("gh release download v1.0.2")
+#' # rnet_x = sf::read_sf("rnet_x_ed.geojson")
+#' # rnet_y = sf::read_sf("rnet_y_ed.geojson")
+#' # rnet_merged = rnet_merge(rnet_x, rnet_y, dist = 9, segment_length = 20, funs = funs)
 #' @return An sf object with the same geometry as `rnet_x`
 rnet_merge <- function(rnet_x, rnet_y, dist = 5, funs = NULL, sum_flows = TRUE, ...) {
   if (is.null(funs)) {

vignettes/merging-route-networks.Rmd

@@ -0,0 +1,62 @@
+---
+title: "Merging route networks"
+output: rmarkdown::html_vignette
+vignette: >
+  %\VignetteIndexEntry{Merging route networks}
+  %\VignetteEngine{knitr::rmarkdown}
+  %\VignetteEncoding{UTF-8}
+---
+
+```{r, include = FALSE}
+knitr::opts_chunk$set(
+  collapse = TRUE,
+  # # Uncomment to speed-up build
+  # eval = FALSE,
+  comment = "#>"
+)
+# devtools::load_all()
+```
+
+```{r setup}
+library(stplanr)
+library(dplyr)
+library(tmap)
+rnet_x = sf::read_sf("https://github.com/ropensci/stplanr/releases/download/v1.0.2/rnet_x_ed.geojson")
+rnet_y = sf::read_sf("https://github.com/ropensci/stplanr/releases/download/v1.0.2/rnet_y_ed.geojson")
+# dups = duplicated(rnet_x$geometry)
+# summary(dups)
+# rnet_x = rnet_x |>
+#   filter(!dups)
+# sf::write_sf(rnet_x, "~/github/ropensci/stplanr/rnet_x_ed.geojson", delete_dsn = TRUE)
+```
+
+# Target network preprocessing
+
+We can pre-process the input in a number of ways, e.g.:
+
+```{r, out.width="100%", fig.width=8, fig.height=6}
+tmap_mode("view")
+nrow(rnet_x)
+summary(sf::st_length(rnet_x))
+plot(sf::st_geometry(rnet_x))
+rnet_x = rnet_subset(rnet_x, rnet_y, dist = 20)
+nrow(rnet_x)
+plot(sf::st_geometry(rnet_x))
+# rnet_x = rnet_subset(rnet_x, rnet_y, dist = 20, min_x = 5, rm_short = TRUE)
+# summary(sf::st_length(rnet_x))
+# nrow(rnet_x)
+# plot(sf::st_geometry(rnet_x))
+rnet_x = rnet_subset(rnet_x, rnet_y, dist = 20, rm_disconnected = TRUE)
+nrow(rnet_x)
+plot(sf::st_geometry(rnet_x))
+```
+
+
+
+```{r}
+funs = list(value = sum, Quietness = mean)
+
+rnet_merged = rnet_merge(rnet_x, rnet_y, dist = 9, segment_length = 20, funs = funs)
+
+```
+

vignettes/stplanr-route-nets.Rmd

@@ -7,8 +7,6 @@ vignette: >
   %\VignetteEncoding{UTF-8}
 ---
 
-## This vignette is work in progress - watch this space!
-
 ```{r, include = FALSE}
 knitr::opts_chunk$set(
   collapse = TRUE,
@@ -27,7 +25,6 @@ library(sf)
 Route networks represent the network of highways, cycleways, footways and other ways along which transport happens.
 You can get route network data from OpenStreetMap (e.g. via the `osmdata` R package) and other providers or transport network data.
 
-
 # Creating route networks from overlapping routes
 
 Unlike routes, each segment geometry in a route network can only appear once.