From 93c2cc0e5aa8d210b91328621b0bb80645a994af Mon Sep 17 00:00:00 2001 From: Luuk van der Meer Date: Mon, 30 Dec 2024 18:27:53 +0100 Subject: [PATCH] refactor: Align with igraph updates :construction: --- NAMESPACE | 1 + R/ids.R | 91 ++++++++++++++++++++++++++++++++++++++++++++++ R/igraph.R | 79 ++++++++++++++++++++++++++++++++++++++++ R/smooth.R | 21 ++++------- R/utils.R | 53 --------------------------- man/wrap_igraph.Rd | 2 +- 6 files changed, 180 insertions(+), 67 deletions(-) create mode 100644 R/igraph.R diff --git a/NAMESPACE b/NAMESPACE index 2057b4b9..fdc4fddb 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -229,6 +229,7 @@ importFrom(igraph,is_dag) importFrom(igraph,is_directed) importFrom(igraph,is_simple) importFrom(igraph,k_shortest_paths) +importFrom(igraph,make_graph) importFrom(igraph,mst) importFrom(igraph,reverse_edges) importFrom(igraph,shortest_paths) diff --git a/R/ids.R b/R/ids.R index 5f01defb..e5acf224 100644 --- a/R/ids.R +++ b/R/ids.R @@ -188,6 +188,97 @@ evaluate_edge_query = function(data, query) { edges } +#' Extract for a given node in a spatial network the indices of adjacent nodes +#' +#' @param x An object of class \code{\link{sfnetwork}}. +#' +#' @param node The integer index of the node for which adjacent nodes should be +#' queried. +#' +#' @param direction The direction of travel. Defaults to \code{'out'}, meaning +#' that the direction given by the network is followed and a node is adjacent +#' if it can be reached by an outgoing edge. May be set to \code{'in'}, meaning +#' that the opposite direction is followed. May also be set to \code{'all'}, +#' meaning that the network is considered to be undirected. This argument is +#' ignored for undirected networks. +#' +#' @returns A vector of integer indices specifying the adjacent nodes to the +#' given node. +#' +#' @importFrom igraph adjacent_vertices igraph_opt igraph_options +#' @noRd +node_adjacent_ids = function(x, node, direction = "out") { + # Change default igraph options. + # This prevents igraph returns node or edge indices as formatted sequences. + # We only need the "raw" integer indices. + # Changing this option can lead to quite a performance improvement. + default_igraph_opt = igraph_opt("return.vs.es") + if (default_igraph_opt) { + igraph_options(return.vs.es = FALSE) + on.exit(igraph_options(return.vs.es = default_igraph_opt)) + } + # Query adjacent nodes and correct for zero-based indexing if needed. + adjacent_vertices(x, node, mode = direction)[[1]] + get_igraph_offset() +} + +#' Extract for each node in a spatial network the indices of incident edges +#' +#' @param x An object of class \code{\link{sfnetwork}}. +#' +#' @param nodes A vector of integer indices specifying the nodes for which +#' incident edges should be queried. +#' +#' @returns A list in which each element is a vector of integer indices +#' specifying the incident edges to one of the given nodes. +#' +#' @importFrom igraph incident_edges igraph_opt igraph_options +#' @noRd +node_incident_ids = function(x, nodes) { + # Change default igraph options. + # This prevents igraph returns node or edge indices as formatted sequences. + # We only need the "raw" integer indices. + # Changing this option can lead to quite a performance improvement. + default_igraph_opt = igraph_opt("return.vs.es") + if (default_igraph_opt) { + igraph_options(return.vs.es = FALSE) + on.exit(igraph_options(return.vs.es = default_igraph_opt)) + } + # Query incident edges and correct for zero-based indexing if needed. + ids = incident_edges(x, nodes, mode = "all") + ids = lapply(ids, `+`, get_igraph_offset()) + ids +} + +#' Extract for a node pair in a spatial network the indices of connecting edges +#' +#' @param x An object of class \code{\link{sfnetwork}}. +#' +#' @param nodes A vector of two integer indices specifying the node pair +#' between which edges should be found. +#' +#' @note If the network is directed, this function will only return the +#' edges that go from the first node of the given pair to the second node +#' of the given pair. +#' +#' @returns A vector of integer indices specifying the edges between the +#' given nodes. +#' +#' @importFrom igraph get_edge_ids igraph_opt igraph_options +#' @noRd +node_connector_ids = function(x, nodes) { + # Change default igraph options. + # This prevents igraph returns node or edge indices as formatted sequences. + # We only need the "raw" integer indices. + # Changing this option can lead to quite a performance improvement. + default_igraph_opt = igraph_opt("return.vs.es") + if (default_igraph_opt) { + igraph_options(return.vs.es = FALSE) + on.exit(igraph_options(return.vs.es = default_igraph_opt)) + } + # Query edge indices. + get_edge_ids(x, nodes, error = TRUE) +} + #' Extract for each edge in a spatial network the indices of incident nodes #' #' @param x An object of class \code{\link{sfnetwork}}. diff --git a/R/igraph.R b/R/igraph.R new file mode 100644 index 00000000..2f52d7e6 --- /dev/null +++ b/R/igraph.R @@ -0,0 +1,79 @@ +#' Run an igraph function on an sfnetwork object +#' +#' Since \code{\link{sfnetwork}} objects inherit \code{\link[igraph]{igraph}} +#' objects, any igraph function can be called on a sfnetwork. However, if this +#' function returns a network, it will be an igraph object rather than a +#' sfnetwork object. With \code{\link{wrap_igraph}}, such a function will +#' preserve the sfnetwork class, after checking if the network returned by +#' igraph still has a valid spatial network structure. +#' +#' @param .data An object of class \code{\link{sfnetwork}}. +#' +#' @param .f An function from the \code{\link[igraph]{igraph}} package that +#' accepts a graph as its first argument, and returns a graph. +#' +#' @param ... Arguments passed on to \code{.f}. +#' +#' @param .force Should network validity checks be skipped? Defaults to +#' \code{FALSE}, meaning that network validity checks are executed when +#' returning the new network. These checks guarantee a valid spatial network +#' structure. For the nodes, this means that they all should have \code{POINT} +#' geometries. In the case of spatially explicit edges, it is also checked that +#' all edges have \code{LINESTRING} geometries, nodes and edges have the same +#' CRS and boundary points of edges match their corresponding node coordinates. +#' These checks are important, but also time consuming. If you are already sure +#' your input data meet the requirements, the checks are unnecessary and can be +#' turned off to improve performance. +#' +#' @param .message Should informational messages (those messages that are +#' neither warnings nor errors) be printed when constructing the network? +#' Defaults to \code{TRUE}. +#' +#' @return An object of class \code{\link{sfnetwork}}. +#' +#' @examples +#' oldpar = par(no.readonly = TRUE) +#' par(mar = c(1,1,1,1), mfrow = c(1,2)) +#' +#' net = as_sfnetwork(mozart, "delaunay", directed = FALSE) +#' mst = wrap_igraph(net, igraph::mst, .message = FALSE) +#' mst +#' +#' plot(net) +#' plot(mst) +#' +#' par(oldpar) +#' +#' @export +wrap_igraph = function(.data, .f, ..., .force = FALSE, .message = TRUE) { + out = .f(.data, ...) %preserve_all_attrs% .data + if (! .force) validate_network(out, message = .message) + out +} + +#' Get the offset of node and edge indices returned by igraph +#' +#' The functions \code{\link[igraph]{adjacent_vertices}} and +#' \code{\link[igraph]{incident_edges}} used to return zero-based indices. +#' Since v2.1.2, it returns one-based indices instead. To not fix the required +#' igraph version to the latest release, this utility function finds the offset +#' of returned indices compared to one-based indexing. +#' +#' @note This function assumes that the igraph option \code{return.vs.es} is +#' set to \code{FALSE}! +#' +#' @returns An integer, 1 if zero-based indexing is used, and 0 if one-based +#' indexing is used. +#' +#' @importFrom igraph adjacent_vertices make_graph +#' @noRd +get_igraph_offset = function() { + if (! is.null(igraph_offset$offset)) return(igraph_offset$offset) + net = make_graph(edges = c(1L, 2L)) + idx = as.integer(adjacent_vertices(net, v = 1L, mode = "out")) + off = 2L - idx + igraph_offset$offset = off + off +} + +igraph_offset = new.env(parent = emptyenv()) \ No newline at end of file diff --git a/R/smooth.R b/R/smooth.R index c4596c18..f407c565 100644 --- a/R/smooth.R +++ b/R/smooth.R @@ -38,9 +38,8 @@ #' #' @importFrom cli cli_abort #' @importFrom dplyr distinct slice -#' @importFrom igraph adjacent_vertices decompose degree delete_vertices -#' edge_attr get_edge_ids igraph_opt igraph_options incident_edges -#' induced_subgraph is_directed vertex_attr +#' @importFrom igraph decompose degree delete_vertices edge_attr get_edge_ids +#' igraph_opt igraph_options induced_subgraph is_directed vertex_attr #' @importFrom sf st_as_sf st_cast st_combine st_crs st_drop_geometry #' st_equals st_is st_line_merge #' @export @@ -88,8 +87,8 @@ smooth_pseudo_nodes = function(x, protect = NULL, pseudo_ids = which(pseudo) edge_attrs = st_drop_geometry(edges) edge_attrs = edge_attrs[, names(edge_attrs) %in% require_equal] - incident_ids = incident_edges(x, pseudo_ids, mode = "all") - check_equality = function(i) nrow(distinct(slice(edge_attrs, i + 1))) < 2 + incident_ids = node_incident_ids(x, pseudo_ids) + check_equality = function(i) nrow(distinct(slice(edge_attrs, i))) < 2 pass = do.call("c", lapply(incident_ids, check_equality)) pseudo[pseudo_ids[!pass]] = FALSE } @@ -147,15 +146,13 @@ smooth_pseudo_nodes = function(x, protect = NULL, # --> The index of the edge that comes in to the pseudo node set. # --> The index of the non-pseudo node at the other end of that edge. # We'll call this the source node and source edge of the set. - # Note the + 1 since adjacent_vertices returns indices starting from 0. - source_node = adjacent_vertices(x, n_i, mode = "in")[[1]] + 1 + source_node = node_adjacent_ids(x, n_i, direction = "in") source_edge = get_edge_ids(x, c(source_node, n_i)) # Find the following: # --> The index of the edge that goes out of the pseudo node set. # --> The index of the non-pseudo node at the other end of that edge. # We'll call this the sink node and sink edge of the set. - # Note the + 1 since adjacent_vertices returns indices starting from 0. - sink_node = adjacent_vertices(x, n_o, mode = "out")[[1]] + 1 + sink_node = node_adjacent_ids(x, n_o, direction = "out") sink_edge = get_edge_ids(x, c(n_o, sink_node)) # List indices of all edges that will be merged into the replacement edge. edge_idxs = c(source_edge, E, sink_edge) @@ -181,8 +178,7 @@ smooth_pseudo_nodes = function(x, protect = NULL, if (length(N) == 1) { # When we have a single pseudo node that forms a set: # --> It will be adjacent to both adjacent nodes of the set. - # Note the + 1 since adjacent_vertices returns indices starting from 0. - adjacent = adjacent_vertices(x, N)[[1]] + 1 + adjacent = node_adjacent_ids(x, N) if (length(adjacent) == 1) { # If there is only one adjacent node to the pseudo node: # --> The two adjacent nodes of the set are the same node. @@ -217,9 +213,8 @@ smooth_pseudo_nodes = function(x, protect = NULL, # We find them iteratively for the two boundary nodes of the set: # --> A boundary connects to one pseudo node and one non-pseudo node. # --> The non-pseudo node is the one not present in the pseudo set. - # Note the + 1 since adjacent_vertices returns indices starting from 0. get_set_neighbour = function(n) { - all = adjacent_vertices(x, n)[[1]] + 1 + all = node_adjacent_ids(x, n) all[!(all %in% N)] } adjacent = do.call("c", lapply(N_b, get_set_neighbour)) diff --git a/R/utils.R b/R/utils.R index 660c2038..06dccb29 100644 --- a/R/utils.R +++ b/R/utils.R @@ -1,56 +1,3 @@ -#' Run an igraph function on an sfnetwork object -#' -#' Since \code{\link{sfnetwork}} objects inherit \code{\link[igraph]{igraph}} -#' objects, any igraph function can be called on a sfnetwork. However, if this -#' function returns a network, it will be an igraph object rather than a -#' sfnetwork object. With \code{\link{wrap_igraph}}, such a function will -#' preserve the sfnetwork class, after checking if the network returned by -#' igraph still has a valid spatial network structure. -#' -#' @param .data An object of class \code{\link{sfnetwork}}. -#' -#' @param .f An function from the \code{\link[igraph]{igraph}} package that -#' accepts a graph as its first argument, and returns a graph. -#' -#' @param ... Arguments passed on to \code{.f}. -#' -#' @param .force Should network validity checks be skipped? Defaults to -#' \code{FALSE}, meaning that network validity checks are executed when -#' returning the new network. These checks guarantee a valid spatial network -#' structure. For the nodes, this means that they all should have \code{POINT} -#' geometries. In the case of spatially explicit edges, it is also checked that -#' all edges have \code{LINESTRING} geometries, nodes and edges have the same -#' CRS and boundary points of edges match their corresponding node coordinates. -#' These checks are important, but also time consuming. If you are already sure -#' your input data meet the requirements, the checks are unnecessary and can be -#' turned off to improve performance. -#' -#' @param .message Should informational messages (those messages that are -#' neither warnings nor errors) be printed when constructing the network? -#' Defaults to \code{TRUE}. -#' -#' @return An object of class \code{\link{sfnetwork}}. -#' -#' @examples -#' oldpar = par(no.readonly = TRUE) -#' par(mar = c(1,1,1,1), mfrow = c(1,2)) -#' -#' net = as_sfnetwork(mozart, "delaunay", directed = FALSE) -#' mst = wrap_igraph(net, igraph::mst, .message = FALSE) -#' mst -#' -#' plot(net) -#' plot(mst) -#' -#' par(oldpar) -#' -#' @export -wrap_igraph = function(.data, .f, ..., .force = FALSE, .message = TRUE) { - out = .f(.data, ...) %preserve_all_attrs% .data - if (! .force) validate_network(out, message = .message) - out -} - #' Determine duplicated geometries #' #' @param x An object of class \code{\link[sf]{sf}} or \code{\link[sf]{sfc}}. diff --git a/man/wrap_igraph.Rd b/man/wrap_igraph.Rd index f8f78be8..0096c5c4 100644 --- a/man/wrap_igraph.Rd +++ b/man/wrap_igraph.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/utils.R +% Please edit documentation in R/igraph.R \name{wrap_igraph} \alias{wrap_igraph} \title{Run an igraph function on an sfnetwork object}