## ----setup, include=FALSE----------------------------------------------------- knitr::opts_chunk$set( collapse = TRUE, comment = "#>" ) knitr::opts_knit$set(global.par = TRUE) ## ----plot, echo=FALSE, results='asis'----------------------------------------- # plot margins oldpar = par(no.readonly = TRUE) par(mar = c(1, 1, 1, 1)) # crayon needs to be explicitly activated in Rmd oldoptions = options() options(crayon.enabled = TRUE) # Hooks needs to be set to deal with outputs # thanks to fansi logic old_hooks = fansi::set_knit_hooks( knitr::knit_hooks, which = c("output", "message", "error") ) ## ----message=FALSE------------------------------------------------------------ library(sfnetworks) library(sf) library(tidygraph) library(igraph) ## ----------------------------------------------------------------------------- net = as_sfnetwork(roxel, directed = FALSE) %>% st_transform(3035) grouped_net = net %>% morph(to_linegraph) %>% mutate(group = group_louvain()) %>% unmorph() grouped_net # The algorithm detected 34 communities. grouped_net %>% activate("edges") %>% pull(group) %>% unique() %>% length() ## ----fig.width=5, fig.height=5------------------------------------------------ plot(st_geometry(net, "edges"), col = "grey", lwd = 0.5) grouped_net %>% activate("edges") %>% st_as_sf() %>% transmute(group = as.factor(group)) %>% filter(group %in% c(1:11)) %>% plot(lwd = 4, add = TRUE) ## ----fig.show='hold', out.width = '50%'--------------------------------------- new_net = net %>% mutate(is_cut = node_is_cut()) %>% morph(to_linegraph) %>% mutate(is_cut = node_is_cut()) %>% unmorph() cut_nodes = new_net %>% activate("nodes") %>% filter(is_cut) %>% st_geometry() cut_edges = new_net %>% activate("edges") %>% filter(is_cut) %>% st_geometry() plot(net, col = "grey", main = "Cut nodes") plot(cut_nodes, col = "red", pch = 20, cex = 2, add = TRUE) plot(net, col = "grey", main = "Cut edges") plot(cut_edges, col = "red", lwd = 4, add = TRUE) ## ----------------------------------------------------------------------------- morphed_net = morph(net, to_components) morphed_net class(morphed_net) length(morphed_net) ## ----------------------------------------------------------------------------- convert(net, to_complement) ## ----fig.show='hold', out.width = '50%'--------------------------------------- new_net = net %>% activate("nodes") %>% filter(group_components() == 1) %>% mutate(foo = sample(c(1:10), graph_order(), replace = TRUE)) %>% mutate(bar = sample(c(TRUE, FALSE), graph_order(), replace = TRUE)) %>% mutate(louvain = as.factor(group_louvain())) contracted_net = convert( new_net, to_spatial_contracted, louvain, simplify = TRUE, summarise_attributes = list( foo = "sum", bar = function(x) any(x), louvain = "first" ) ) plot(st_geometry(new_net, "edges"), main = "Grouped nodes") plot(st_as_sf(new_net)["louvain"], key.pos = NULL, pch = 20, add = TRUE) plot(st_geometry(contracted_net, "edges"), main = "Contracted network") plot( st_as_sf(contracted_net)["louvain"], cex = 2, key.pos = NULL, pch = 20, add = TRUE ) ## ----------------------------------------------------------------------------- net %>% activate("nodes") %>% mutate(bc_undir = centrality_betweenness()) %>% morph(to_spatial_directed) %>% mutate(bc_dir = centrality_betweenness()) %>% unmorph() %>% mutate(bc_diff = bc_dir - bc_undir) %>% arrange(desc(bc_diff)) ## ----fig.show='hold', out.width = '50%'--------------------------------------- implicit_net = st_set_geometry(activate(net, "edges"), NULL) explicit_net = convert(implicit_net, to_spatial_explicit) plot(implicit_net, draw_lines = FALSE, main = "Implicit edges") plot(explicit_net, main = "Explicit edges") ## ----fig.width=5, fig.height=5------------------------------------------------ # Define the origin location. p = net %>% st_geometry() %>% st_combine() %>% st_centroid() # Subset neighborhood. neigh_net = net %>% activate("edges") %>% convert(to_spatial_neighborhood, p, threshold = 500, weights = edge_length()) plot(net, col = "grey") plot(neigh_net, col = "red", add = TRUE) ## ----------------------------------------------------------------------------- net %>% activate("edges") %>% convert( to_spatial_shortest_paths, from = 1, to = 100, weights = edge_length() ) ## ----fig.width=5, fig.height=5------------------------------------------------ new_net = net %>% activate("edges") %>% morph( to_spatial_shortest_paths, from = 1, to = seq(10, 100, 10), weights = edge_length() ) %>% mutate(in_paths = TRUE) %>% unmorph() new_net %>% st_geometry() %>% plot(col = "grey", lwd = 2) new_net %>% filter(in_paths) %>% st_geometry() %>% plot(col = "red", lwd = 4, add = TRUE) ## ----fig.show='hold', out.width = '50%'--------------------------------------- # Add a flow attribute to the edges. # When merging multiple edges, we want the flow of the new edge to be: # --> The sum of the flows of the merged edges. new_net = net %>% activate("edges") %>% mutate(flow = sample(c(1:100), ecount(net), replace = TRUE)) # Select a set of multiple edges to inspect before simplifying. a_multiple = new_net %>% filter(edge_is_multiple()) %>% slice(1) new_net %>% filter(edge_is_between(pull(a_multiple, from), pull(a_multiple, to))) %>% st_as_sf() # Simplify the network. # We summarise the flow attribute by taking the sum of the merged edge flows. # For all the other attributes we simply take the first value in the set. simple_net = new_net %>% convert( to_spatial_simple, summarise_attributes = list(flow = "sum", "first") ) # The multiple edges are merged into one. # The flow is summarised by taking the sum of the merged edge flows. simple_net %>% filter(edge_is_between(pull(a_multiple, from), pull(a_multiple, to))) %>% st_as_sf() ## ----fig.show='hold', out.width = '50%'--------------------------------------- smoothed_net = convert(net, to_spatial_smooth) plot(net, main = "Original network") plot(net, col = "red", cex = 0.8, lwd = 0.1, main = "Smoothed network") plot(smoothed_net, col = "grey", add = TRUE) ## ----------------------------------------------------------------------------- subdivided_net = convert(net, to_spatial_subdivision) # Original network. paste("Number of edges: ", ecount(net)) paste("Number of components: ", count_components(net)) # Subdivided network. # The whole network is now a single connected component! paste("Number of edges: ", ecount(subdivided_net)) paste("Number of components: ", count_components(subdivided_net)) ## ----------------------------------------------------------------------------- codes = net %>% st_make_grid(n = c(2, 2)) %>% st_as_sf() %>% mutate(post_code = seq(1000, 1000 + n() * 10 - 10, 10)) points = st_geometry(net, "nodes")[c(2, 3)] net %>% morph(to_spatial_subset, points, .pred = st_equals) %>% st_join(codes, join = st_intersects) %>% unmorph() ## ----------------------------------------------------------------------------- net = net %>% activate("nodes") %>% mutate(building = sample(c(TRUE, FALSE), n(), replace = TRUE)) net %>% morph(to_subgraph, building) %>% st_join(codes, join = st_intersects) %>% unmorph() ## ----error = TRUE------------------------------------------------------------- # Azimuth calculation fails with our projected CRS. # The function complains the coordinates are not longitude/latitude. net %>% activate("edges") %>% mutate(azimuth = edge_azimuth()) ## ----------------------------------------------------------------------------- # We make it work by temporarily transforming to a different CRS. net %>% activate("edges") %>% morph(to_spatial_transformed, 4326) %>% mutate(azimuth = edge_azimuth()) %>% unmorph() ## ----include = FALSE---------------------------------------------------------- par(oldpar) options(oldoptions)