From 5bd38b276159af2bc6c0822145d8bb75cd276186 Mon Sep 17 00:00:00 2001 From: David Schoch Date: Tue, 18 Feb 2025 08:38:31 +0100 Subject: [PATCH] refactor: consolidate graph.incidence.* (#1483) (#1654) --- R/incidence.R | 181 ++++++++++------------------- tests/testthat/_snaps/incidence.md | 2 +- 2 files changed, 65 insertions(+), 118 deletions(-) diff --git a/R/incidence.R b/R/incidence.R index 0a76209c68..1a727987b6 100644 --- a/R/incidence.R +++ b/R/incidence.R @@ -1,4 +1,3 @@ - #' Create graphs from a bipartite adjacency matrix #' #' @description @@ -37,109 +36,70 @@ 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) - el <- mysummary(incidence) - el[, 2] <- el[, 2] + n1 - if (!is.null(weighted)) { +# adjust edgelist according to directionality of edges +modify_edgelist <- function(el, mode, directed) { + if (!directed || mode == "out") { + # No adjustment needed + return(el) + } + reversed_edges <- el[, c(2, 1, 3)] + if (mode == "in") { + return(reversed_edges) + } + rbind(el, reversed_edges) +} - 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) - } else { - if (multiple) { - el[, 3] <- ceiling(el[, 3]) - el[, 3][el[, 3] < 0] <- 0 - } else { - el[, 3] <- el[, 3] != 0 - } + # Handle dense unweighted matrices first + if (!inherits(incidence, "Matrix") && is.null(weighted)) { + mode(incidence) <- "double" + on.exit(.Call(R_igraph_finalizer)) - 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_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)) + } - edges <- unlist(apply(el, 1, function(x) rep(unname(x[1:2]), x[3]))) - res <- make_graph(n = n1 + n2, edges, directed = directed) + # Convert to sparse matrix if not already sparse + if (!inherits(incidence, "Matrix")) { + incidence <- as(incidence, "dgCMatrix") } - set_vertex_attr(res, "type", value = c(rep(FALSE, n1), rep(TRUE, n2))) -} + el <- mysummary(incidence) + el[, 2] <- el[, 2] + num_rows + el <- as.matrix(el) -graph.incidence.dense <- function(incidence, directed, mode, multiple, - weighted) { - if (!is.null(weighted)) { + el <- modify_edgelist(el, mode, directed) - 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)) - ) + # Construct the graph object from processed edgelist + if (!is.null(weighted)) { + # Handle weighted edges + 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) + # Handle unweighted edges, replicating rows for multiple edges + 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_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 +163,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 +196,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 +237,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 +255,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 diff --git a/tests/testthat/_snaps/incidence.md b/tests/testthat/_snaps/incidence.md index b15badd95f..2b9e6ff16a 100644 --- a/tests/testthat/_snaps/incidence.md +++ b/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