--- title: "Route networks with stplanr" output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{Route networks with stplanr} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- ```{r, include = FALSE} knitr::opts_chunk$set( collapse = TRUE, comment = "#>", eval = all(c(curl::has_internet(), requireNamespace("igraph", quietly = TRUE))) ) ``` ```{r setup, message=FALSE} library(stplanr) library(sf) ``` # Introduction 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. **stplanr** can be used to convert a series of routes into a route network, using the function `overline()`, as illustrated below: ```{r, out.width="40%", fig.show='hold', fig.width=5, message=FALSE} library(stplanr) library(sf) sample_routes <- routes_fast_sf[2:6, 1] sample_routes$value <- rep(1:3, length.out = 5) rnet <- overline(sample_routes, attrib = "value") plot(sample_routes["value"], lwd = sample_routes$value, main = "Routes") plot(rnet["value"], lwd = rnet$value, main = "Route network") ``` The above figure shows how `overline()` breaks the routes into segments with the same values and removes overlapping segments. It is a form of geographic aggregation. ```{r rnets1, message=FALSE, warning=FALSE, out.width="100%", fig.width=6, fig.height=6, echo=FALSE} # knitr::include_graphics("route-networks.png") ``` # Identifying route network groups Route networks can be represented as a graph. Usually all segments are connected together, meaning the graph is [connected](https://en.wikipedia.org/wiki/Connectivity_(graph_theory)#Connected_graph). We can show that very simple network above is connected as follows: ```{r} touching_list = st_intersects(sample_routes) g = igraph::graph.adjlist(touching_list) igraph::is_connected(g) ``` A more complex network may not be connected in this way, as shown in the example below: ```{r, eval=FALSE} # piggyback::pb_download_url("r_key_roads_test.Rds") u = "https://github.com/ropensci/stplanr/releases/download/0.6.0/r_key_roads_test.Rds" rnet_disconnected = readRDS(url(u)) touching_list = sf::st_intersects(rnet_disconnected) g = igraph::graph.adjlist(touching_list) igraph::is_connected(g) #> [1] FALSE sf:::plot.sfc_LINESTRING(rnet_disconnected$geometry) ``` ```{r, echo=FALSE} knitr::include_graphics("https://i.imgur.com/827f761.png") ``` The elements of the network are clearly divided into groups. We can identify these groups as follows: ```{r, eval=FALSE} rnet_disconnected$group = rnet_igroup(rnet_disconnected) ``` # Routing on route networks ```{r, out.width="49%", fig.show='hide'} # plot(rnet$geometry) # plot(sln_nodes, add = TRUE) # xy_path <- sum_network_routes(sln = sln, start = xy_nodes[1], end = xy_nodes[2], sumvars = "length") # # xy_path = sum_network_links(sln = sln, start = xy_nodes[1], end = xy_nodes[2]) # plot(rnet$geometry) # plot(xy_sf$geometry, add = TRUE) # plot(xy_path$geometry, add = TRUE, lwd = 5) ``` # Adding new nodes New nodes can be added to the network, although this should be done before the graph representation is created. Imagine we want to create a point half way along the the most westerly route segment in the network, near the coordinates -1.540, 53.826: ```{r netpoint} new_point_coordinates <- c(-1.540, 53.826) p <- sf::st_sf(geometry = sf::st_sfc(sf::st_point(new_point_coordinates)), crs = 4326) ``` # Other approaches Other approaches to working with route networks include: - [sDNA](https://github.com/fiftysevendegreesofrad/sdna_open), an open source C++ library for analysing route networks and estimating flows at segments across network segments - [sfnetworks](https://github.com/luukvdmeer/sfnetworks), an R package that provides an alternative igraph/sf spatial network class - [dodgr](https://github.com/UrbanAnalyst/dodgr), an R package providing functions for calculating distances on directed graphs - [cppRouting](https://cran.r-project.org/package=cppRouting), a package for routing in C++ - Chapter [10 of Geocomputation with R](https://r.geocompx.org/transport.html), which provides context and demonstrates a transport planning workflow in R. ```{r, message=FALSE, warning=FALSE, out.width="100%", fig.width=6, fig.height=6, echo=FALSE, eval=FALSE} # Show solutions to https://github.com/ropensci/stplanr/issues/237 library(tmap) # sample_routes = routes_fast_sf # sample_routes$id <- 1:nrow(sample_routes) # sample_routes <- sample_routes[!is.na(sample_routes$plan),] sample_routes <- routes_fast_sf[c(22, 38, 39, 46, 47), NULL] sample_routes$type <- " Routes" v <- 1:5 n <- c(2, 3, 5) # route_list = purrr::map(n, ~sample_routes[1:., ]) route_list <- lapply(n, function(x) { l <- sample_routes[1:x, ] l$n <- x l$value <- rep(v, length.out = x) l }) routes_all <- do.call(rbind, route_list) # rnet_list = purrr::map(route_list, function(x) { rnet_list <- lapply(route_list, function(x) { l <- overline2(x, "value") l$n <- mean(x$n) l }) rnet_all <- do.call(rbind, rnet_list) rnet_all$type <- "Route network" all_routes <- rbind(routes_all, rnet_all) p <- sf::st_centroid(all_routes) tmap_mode("plot") m <- tm_shape(all_routes, bbox = tmaptools::bb(all_routes)) + tm_lines( col = "value", lwd = 1, palette = "OrRd", scale = 8, alpha = 0.8, breaks = 0:6, legend.lwd.show = FALSE, labels = as.character(1:6), legend.col.show = FALSE ) + tm_text("value") + tm_facets(by = c("n", "type")) + tm_layout(scale = 1.5) # m tmap_save(m, "vignettes/route-networks.png") ``` ```{r, eval=FALSE, echo=FALSE} # test code: sample_routes2 <- sample_routes5[2:3, ] sample_routes3 <- sample_routes5[2:4, ] rnet2 <- overline2(sample_routes2, attrib = "value") rnet3 <- overline2(sample_routes3, attrib = "value") rnet5 <- overline2(sample_routes5, attrib = "value") b <- 0:6 bb <- tmaptools::bb(rnet, ext = 1.1) rnet5$n <- 5 rnet5$type <- "Route network" sample_routes5$n <- 5 sample_routes5$type <- " Routes" all_routes <- rbind(rnet5, sample_routes5) m2 <- tm_shape(sample_routes[1:2, ], bbox = bb) + tm_lines(col = "value", lwd = "value", palette = "magma", scale = 8, alpha = 0.5, breaks = b) + tm_layout(title = "2 Routes", legend.show = FALSE) r2 <- tm_shape(rnet2, bbox = bb) + tm_lines( col = "value", palette = "viridis", scale = 10, alpha = 0.5, breaks = b, legend.lwd.show = FALSE, labels = as.character(1:6) ) m3 <- tm_shape(sample_routes[1:3, ], bbox = bb) + tm_lines(col = "value", lwd = "value", palette = "viridis", scale = 15, alpha = 0.5, breaks = b) + tm_layout(title = "3 Routes", legend.show = FALSE) r3 <- tm_shape(rnet3, bbox = bb) + tm_lines(col = "value", palette = "viridis", scale = 8, alpha = 0.5, breaks = b) + tm_layout(legend.show = FALSE) m6 <- tm_shape(sample_routes, bbox = bb) + tm_lines(col = "value", lwd = "value", palette = "viridis", scale = 10, alpha = 0.5, breaks = b) + tm_layout(title = "6 Routes", legend.show = FALSE) r6 <- tm_shape(rnet, bbox = bb) + tm_lines(col = "value", palette = "viridis", scale = 8, alpha = 0.5, breaks = b) + tm_layout(legend.show = FALSE) tmap_arrange(m2, r2, m3, r3, m6, r6, nrow = 3) ```