refactor: consolidate graph.incidence.* (#1483)

R/incidence.R

@@ -1,4 +1,3 @@
-
 #' Create graphs from a bipartite adjacency matrix
 #'
 #' @description
@@ -37,109 +36,77 @@ graph.incidence <- function(incidence, directed = FALSE, mode = c("all", "out",
 ##
 ## -----------------------------------------------------------------
 
-graph.incidence.sparse <- function(incidence, directed, mode, multiple,
-                                   weighted) {
-  n1 <- nrow(incidence)
-  n2 <- ncol(incidence)
+# Helper function to process sparse matrices (matrix to edgelist)
+process.sparse <- function(incidence, num_rows) {
   el <- mysummary(incidence)
-  el[, 2] <- el[, 2] + n1
+  # adjust indices for second column to create a second mode
+  el[, 2] <- el[, 2] + num_rows
+  as.matrix(el)
+}
 
-  if (!is.null(weighted)) {
+# adjust edgelist according to directionality of edges
+adjust.directionality <- function(el, mode, directed) {
+  if (!directed || mode == "out") {
+    # No adjustment needed
+    return(el)
+  } else if (mode == "in") {
+    # Reverse the edges
+    el[, 1:2] <- el[, c(2, 1)]
+  } else if (mode %in% c("all", "total")) {
+    # Add reversed edges
+    reversed_edges <- el[, c(2, 1, 3)]
+    el <- rbind(el, reversed_edges)
+  }
+  el
+}
 
-    if (!directed || mode == 1) {
-      ## nothing do to
-    } else if (mode == 2) {
-      el[, 1:2] <- el[, c(2, 1)]
-    } else if (mode == 3) {
-      reversed_el <- el[, c(2, 1, 3)]
-      names(reversed_el) <- names(el)
-      el <- rbind(el, reversed_el)
-    }
+graph.incidence.build <- function(incidence, directed = FALSE, mode = "out",
+                                  multiple = FALSE, weighted = NULL) {
+  num_rows <- nrow(incidence)
+  num_cols <- ncol(incidence)
 
-    res <- make_empty_graph(n = n1 + n2, directed = directed)
-    weight <- list(el[, 3])
-    names(weight) <- weighted
-    res <- add_edges(res, edges = t(as.matrix(el[, 1:2])), attr = weight)
+  if (inherits(incidence, "Matrix")) {
+    # General Sparse matrix processing
+    el <- process.sparse(incidence, num_rows)
+  } else if (!is.null(weighted)) {
+    # Dense weighted matrix processing (convert to sparse matrix first)
+    el <- process.sparse(as(incidence, "dgCMatrix"), num_rows)
   } else {
-    if (multiple) {
-      el[, 3] <- ceiling(el[, 3])
-      el[, 3][el[, 3] < 0] <- 0
-    } else {
-      el[, 3] <- el[, 3] != 0
-    }
-
-    if (!directed || mode == 1) {
-      ## nothing do to
-    } else if (mode == 2) {
-      el[, 1:2] <- el[, c(2, 1)]
-    } else if (mode == 3) {
-      el <- rbind(el, el[, c(2, 1, 3)])
-    }
+    mode(incidence) <- "double"
+    on.exit(.Call(R_igraph_finalizer))
 
-    edges <- unlist(apply(el, 1, function(x) rep(unname(x[1:2]), x[3])))
-    res <- make_graph(n = n1 + n2, edges, directed = directed)
+    # Dense unweighted matrix (potentially with multiple edges)
+    mode_num <- switch(mode,
+      "out" = 1,
+      "in" = 2,
+      "all" = 3,
+      "total" = 3
+    )
+    res <- .Call(R_igraph_biadjacency, incidence, directed, mode_num, multiple)
+    return(set_vertex_attr(res$graph, "type", value = res$types))
   }
 
-  set_vertex_attr(res, "type", value = c(rep(FALSE, n1), rep(TRUE, n2)))
-}
+  # Adjust edgelist for directionality and mode
+  el <- adjust.directionality(el, mode, directed)
 
-graph.incidence.dense <- function(incidence, directed, mode, multiple,
-                                  weighted) {
+  # Handle weights or replicate rows for multiple edges
   if (!is.null(weighted)) {
-
-    n1 <- nrow(incidence)
-    n2 <- ncol(incidence)
-    no.edges <- sum(incidence != 0)
-    if (directed && mode == 3) {
-      no.edges <- no.edges * 2
-    }
-    edges <- numeric(2 * no.edges)
-    weight <- numeric(no.edges)
-    ptr <- 1
-    for (i in seq_len(nrow(incidence))) {
-      for (j in seq_len(ncol(incidence))) {
-        if (incidence[i, j] != 0) {
-          if (!directed || mode == 1) {
-            edges[2 * ptr - 1] <- i
-            edges[2 * ptr] <- n1 + j
-            weight[ptr] <- incidence[i, j]
-            ptr <- ptr + 1
-          } else if (mode == 2) {
-            edges[2 * ptr - 1] <- n1 + j
-            edges[2 * ptr] <- i
-            weight[ptr] <- incidence[i, j]
-            ptr <- ptr + 1
-          } else if (mode == 3) {
-            edges[2 * ptr - 1] <- i
-            edges[2 * ptr] <- n1 + j
-            weight[ptr] <- incidence[i, j]
-            ptr <- ptr + 1
-            edges[2 * ptr - 1] <- n1 + j
-            edges[2 * ptr] <- i
-            weight[ptr] <- incidence[i, j]
-            ptr <- ptr + 1
-          }
-        }
-      }
-    }
-    res <- make_empty_graph(n = n1 + n2, directed = directed)
-    weight <- list(weight)
-    names(weight) <- weighted
-    res <- add_edges(res, edges, attr = weight)
-    res <- set_vertex_attr(res, "type",
-      value = c(rep(FALSE, n1), rep(TRUE, n2))
-    )
+    res <- make_empty_graph(n = num_rows + num_cols, directed = directed)
+    weight_attr <- list(el[, 3])
+    names(weight_attr) <- weighted
+    res <- add_edges(res, edges = t(el[, 1:2]), attr = weight_attr)
   } else {
-    mode(incidence) <- "double"
-    on.exit(.Call(R_igraph_finalizer))
-    ## Function call
-    res <- .Call(R_igraph_biadjacency, incidence, directed, mode, multiple)
-    res <- set_vertex_attr(res$graph, "type", value = res$types)
+    # create multiple edges according to the third column
+    el <- el[rep(seq_len(nrow(el)), times = el[, 3]), 1:2]
+    res <- make_graph(n = num_rows + num_cols, c(t(el)), directed = directed)
   }
 
-  res
+  # Set vertex attributes and return
+  set_vertex_attr(res, "type", value = c(rep(FALSE, num_rows), rep(TRUE, num_cols)))
 }
 
+
+
 #' Create graphs from a bipartite adjacency matrix
 #'
 #' `graph_from_biadjacency_matrix()` creates a bipartite igraph graph from an incidence
@@ -203,22 +170,17 @@ graph.incidence.dense <- function(incidence, directed, mode, multiple,
 #' @family biadjacency
 #' @export
 graph_from_biadjacency_matrix <- function(incidence, directed = FALSE,
-                                        mode = c("all", "out", "in", "total"),
-                                        multiple = FALSE, weighted = NULL,
-                                        add.names = NULL) {
+                                          mode = c("all", "out", "in", "total"),
+                                          multiple = FALSE, weighted = NULL,
+                                          add.names = NULL) {
   # Argument checks
   directed <- as.logical(directed)
-  mode <- switch(igraph.match.arg(mode),
-    "out" = 1,
-    "in" = 2,
-    "all" = 3,
-    "total" = 3
-  )
+  mode <- igraph.match.arg(mode)
+
   multiple <- as.logical(multiple)
 
   if (!is.null(weighted)) {
     if (is.logical(weighted) && weighted) {
-
       if (multiple) {
         cli::cli_abort(c(
           "{.arg multiple} and {.arg weighted} cannot be both {.code TRUE}.",
@@ -241,19 +203,11 @@ graph_from_biadjacency_matrix <- function(incidence, directed = FALSE,
     }
   }
 
-  if (inherits(incidence, "Matrix")) {
-    res <- graph.incidence.sparse(incidence,
-      directed = directed,
-      mode = mode, multiple = multiple,
-      weighted = weighted
-    )
-  } else {
-    incidence <- as.matrix(incidence)
-    res <- graph.incidence.dense(incidence,
-      directed = directed, mode = mode,
-      multiple = multiple, weighted = weighted
-    )
-  }
+  res <- graph.incidence.build(incidence,
+    directed = directed,
+    mode = mode, multiple = multiple,
+    weighted = weighted
+  )
 
   ## Add names
   if (is.null(add.names)) {
@@ -290,8 +244,8 @@ graph_from_biadjacency_matrix <- function(incidence, directed = FALSE,
 #' this naming to avoid confusion with the edge-vertex incidence matrix.
 #' @export
 from_incidence_matrix <- function(...) { # nocov start
-   lifecycle::deprecate_soft("1.6.0", "graph_from_incidence_matrix()", "graph_from_biadjacency_matrix()")
-   graph_from_biadjacency_matrix(...)
+  lifecycle::deprecate_soft("1.6.0", "graph_from_incidence_matrix()", "graph_from_biadjacency_matrix()")
+  graph_from_biadjacency_matrix(...)
 } # nocov end
 #' From incidence matrix
 #'
@@ -308,6 +262,6 @@ from_incidence_matrix <- function(...) { # nocov start
 #' this naming to avoid confusion with the edge-vertex incidence matrix.
 #' @export
 graph_from_incidence_matrix <- function(...) { # nocov start
-   lifecycle::deprecate_soft("1.6.0", "graph_from_incidence_matrix()", "graph_from_biadjacency_matrix()")
-   graph_from_biadjacency_matrix(...)
+  lifecycle::deprecate_soft("1.6.0", "graph_from_incidence_matrix()", "graph_from_biadjacency_matrix()")
+  graph_from_biadjacency_matrix(...)
 } # nocov end

tests/testthat/_snaps/incidence.md

@@ -16,7 +16,7 @@
       IGRAPH UNWB 8 7 -- 
       + attr: type (v/l), name (v/c), weight (e/n)
       + edges (vertex names):
-      [1] A--c A--d B--b B--c B--e C--b C--d
+      [1] B--b C--b A--c B--c A--d C--d B--e
 
 # graph_from_biadjacency_matrix() works -- dense + multiple