refactor: Align with igraph updates 🚧

Author: luukvdmeer

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)

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}}.

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())

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))

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}}.