From b4d704f1a191151b61d83da51b4ee43edd7cfa3d Mon Sep 17 00:00:00 2001 From: schochastics Date: Sat, 21 Sep 2024 07:31:50 +0200 Subject: [PATCH 01/13] removed for loops in graph.incidence.dense --- R/incidence.R | 71 +++++++++++++++++++-------------------------------- 1 file changed, 26 insertions(+), 45 deletions(-) diff --git a/R/incidence.R b/R/incidence.R index 0a76209c684..3e415469a5a 100644 --- a/R/incidence.R +++ b/R/incidence.R @@ -1,4 +1,3 @@ - #' Create graphs from a bipartite adjacency matrix #' #' @description @@ -89,46 +88,27 @@ graph.incidence.dense <- function(incidence, directed, mode, multiple, 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 - } - } - } + + idx <- which(incidence != 0, arr.ind = TRUE) + el <- cbind(idx, incidence[idx]) + + el[, 2] <- el[, 2] + n1 + + 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) } + res <- make_empty_graph(n = n1 + n2, directed = directed) - weight <- list(weight) + weight <- list(el[, 3]) 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 <- add_edges(res, edges = t(as.matrix(el[, 1:2])), attr = weight) + res <- set_vertex_attr(res, "type", value = c(rep(FALSE, n1), rep(TRUE, n2))) } else { mode(incidence) <- "double" on.exit(.Call(R_igraph_finalizer)) @@ -140,6 +120,7 @@ graph.incidence.dense <- function(incidence, directed, mode, multiple, res } + #' Create graphs from a bipartite adjacency matrix #' #' `graph_from_biadjacency_matrix()` creates a bipartite igraph graph from an incidence @@ -203,9 +184,9 @@ 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), @@ -290,8 +271,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 +289,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 From d7b6675c2eac9dc736c9b63ff30b90222bfffdbd Mon Sep 17 00:00:00 2001 From: schochastics Date: Wed, 9 Oct 2024 21:34:57 +0200 Subject: [PATCH 02/13] added comments to graph.incidence.sparse --- R/incidence.R | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/R/incidence.R b/R/incidence.R index 3e415469a5a..d80d684d512 100644 --- a/R/incidence.R +++ b/R/incidence.R @@ -44,7 +44,6 @@ graph.incidence.sparse <- function(incidence, directed, mode, multiple, el[, 2] <- el[, 2] + n1 if (!is.null(weighted)) { - if (!directed || mode == 1) { ## nothing do to } else if (mode == 2) { @@ -85,13 +84,16 @@ graph.incidence.sparse <- function(incidence, directed, mode, multiple, graph.incidence.dense <- function(incidence, directed, mode, multiple, weighted) { if (!is.null(weighted)) { - n1 <- nrow(incidence) n2 <- ncol(incidence) + # create an edgelist from the nonzero entries of the + # incidence matrix idx <- which(incidence != 0, arr.ind = TRUE) + # add the value of the matrix. So a row is [s,t,incidence[s,t]] el <- cbind(idx, incidence[idx]) + # move from separate row/col indexing to 1..n1+n2 indexing el[, 2] <- el[, 2] + n1 if (!directed || mode == 1) { @@ -199,7 +201,6 @@ graph_from_biadjacency_matrix <- function(incidence, directed = FALSE, 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}.", From c48d8f675d8c2cbacfba5b2a24f6afe7cb07463a Mon Sep 17 00:00:00 2001 From: schochastics Date: Wed, 9 Oct 2024 21:49:14 +0200 Subject: [PATCH 03/13] moved mode recoding from graph_from_biadjacency_matrix into subroutines --- R/incidence.R | 32 +++++++++++++++++--------------- 1 file changed, 17 insertions(+), 15 deletions(-) diff --git a/R/incidence.R b/R/incidence.R index d80d684d512..b2a0a4c1cb0 100644 --- a/R/incidence.R +++ b/R/incidence.R @@ -44,11 +44,11 @@ graph.incidence.sparse <- function(incidence, directed, mode, multiple, el[, 2] <- el[, 2] + n1 if (!is.null(weighted)) { - if (!directed || mode == 1) { + if (!directed || mode == "out") { ## nothing do to - } else if (mode == 2) { + } else if (mode == "in") { el[, 1:2] <- el[, c(2, 1)] - } else if (mode == 3) { + } else if (mode %in% c("all", "total")) { reversed_el <- el[, c(2, 1, 3)] names(reversed_el) <- names(el) el <- rbind(el, reversed_el) @@ -66,11 +66,11 @@ graph.incidence.sparse <- function(incidence, directed, mode, multiple, el[, 3] <- el[, 3] != 0 } - if (!directed || mode == 1) { + if (!directed || mode == "out") { ## nothing do to - } else if (mode == 2) { + } else if (mode == "in") { el[, 1:2] <- el[, c(2, 1)] - } else if (mode == 3) { + } else if (mode %in% c("all", "total")) { el <- rbind(el, el[, c(2, 1, 3)]) } @@ -96,11 +96,11 @@ graph.incidence.dense <- function(incidence, directed, mode, multiple, # move from separate row/col indexing to 1..n1+n2 indexing el[, 2] <- el[, 2] + n1 - if (!directed || mode == 1) { + if (!directed || mode == "out") { ## nothing do to - } else if (mode == 2) { + } else if (mode == "in") { el[, 1:2] <- el[, c(2, 1)] - } else if (mode == 3) { + } else if (mode %in% c("all", "total")) { reversed_el <- el[, c(2, 1, 3)] names(reversed_el) <- names(el) el <- rbind(el, reversed_el) @@ -115,6 +115,12 @@ graph.incidence.dense <- function(incidence, directed, mode, multiple, mode(incidence) <- "double" on.exit(.Call(R_igraph_finalizer)) ## Function call + mode <- switch(mode, + "out" = 1, + "in" = 2, + "all" = 3, + "total" = 3 + ) res <- .Call(R_igraph_biadjacency, incidence, directed, mode, multiple) res <- set_vertex_attr(res$graph, "type", value = res$types) } @@ -191,12 +197,8 @@ graph_from_biadjacency_matrix <- function(incidence, directed = FALSE, 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)) { From 076eef1cb1fc0cb627c063f1a908ef7fd6e77e7c Mon Sep 17 00:00:00 2001 From: schochastics Date: Thu, 9 Jan 2025 19:26:20 +0100 Subject: [PATCH 04/13] add edges in row-first order not col-first --- R/incidence.R | 2 ++ 1 file changed, 2 insertions(+) diff --git a/R/incidence.R b/R/incidence.R index b2a0a4c1cb0..8bd3d747da3 100644 --- a/R/incidence.R +++ b/R/incidence.R @@ -90,6 +90,8 @@ graph.incidence.dense <- function(incidence, directed, mode, multiple, # create an edgelist from the nonzero entries of the # incidence matrix idx <- which(incidence != 0, arr.ind = TRUE) + # convert to row-first order + idx <- idx[order(idx[, 1], idx[, 2]), ] # add the value of the matrix. So a row is [s,t,incidence[s,t]] el <- cbind(idx, incidence[idx]) From aa5d7658e50935fb5c61339fbac01c3ae0a6d3cc Mon Sep 17 00:00:00 2001 From: schochastics Date: Tue, 14 Jan 2025 22:00:49 +0100 Subject: [PATCH 05/13] removed *.dense and *.sparse in favor of more specialized helpers --- R/incidence.R | 155 ++++++++++++++++++++------------------------------ 1 file changed, 63 insertions(+), 92 deletions(-) diff --git a/R/incidence.R b/R/incidence.R index 8bd3d747da3..e88d069f994 100644 --- a/R/incidence.R +++ b/R/incidence.R @@ -35,102 +35,81 @@ graph.incidence <- function(incidence, directed = FALSE, mode = c("all", "out", ## 02110-1301 USA ## ## ----------------------------------------------------------------- +# Helper function to process sparse matrices +process.sparse <- function(incidence, num_rows) { + edge_list <- igraph:::mysummary(incidence) # TODO: remove mysummary? + edge_list[, 2] <- edge_list[, 2] + num_rows + as.matrix(edge_list) +} -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)) { - if (!directed || mode == "out") { - ## nothing do to - } else if (mode == "in") { - el[, 1:2] <- el[, c(2, 1)] - } else if (mode %in% c("all", "total")) { - reversed_el <- el[, c(2, 1, 3)] - names(reversed_el) <- names(el) - el <- rbind(el, reversed_el) - } - - 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 - } - - if (!directed || mode == "out") { - ## nothing do to - } else if (mode == "in") { - el[, 1:2] <- el[, c(2, 1)] - } else if (mode %in% c("all", "total")) { - el <- rbind(el, el[, c(2, 1, 3)]) - } +# Helper function to process dense matrices +process.dense <- function(incidence, num_rows) { + nonzero_indices <- which(incidence != 0, arr.ind = TRUE) + nonzero_indices <- nonzero_indices[order(nonzero_indices[, 1], nonzero_indices[, 2]), , drop = FALSE] + edge_list <- cbind(nonzero_indices, incidence[nonzero_indices]) + edge_list[, 2] <- edge_list[, 2] + num_rows + edge_list +} - edges <- unlist(apply(el, 1, function(x) rep(unname(x[1:2]), x[3]))) - res <- make_graph(n = n1 + n2, edges, directed = directed) +adjust.directionality <- function(edge_list, mode, directed) { + if (!directed || mode == "out") { + # No adjustment needed + return(edge_list) + } else if (mode == "in") { + # Reverse the edges + edge_list[, 1:2] <- edge_list[, c(2, 1)] + } else if (mode %in% c("all", "total")) { + # Add reversed edges + reversed_edges <- edge_list[, c(2, 1, 3)] + edge_list <- rbind(edge_list, reversed_edges) } - - set_vertex_attr(res, "type", value = c(rep(FALSE, n1), rep(TRUE, n2))) + edge_list } -graph.incidence.dense <- function(incidence, directed, mode, multiple, - weighted) { - if (!is.null(weighted)) { - n1 <- nrow(incidence) - n2 <- ncol(incidence) - - # create an edgelist from the nonzero entries of the - # incidence matrix - idx <- which(incidence != 0, arr.ind = TRUE) - # convert to row-first order - idx <- idx[order(idx[, 1], idx[, 2]), ] - # add the value of the matrix. So a row is [s,t,incidence[s,t]] - el <- cbind(idx, incidence[idx]) - - # move from separate row/col indexing to 1..n1+n2 indexing - el[, 2] <- el[, 2] + n1 +graph.incidence <- function(incidence, directed = FALSE, mode = "out", + multiple = FALSE, weighted = NULL) { + num_rows <- nrow(incidence) + num_cols <- ncol(incidence) - if (!directed || mode == "out") { - ## nothing do to - } else if (mode == "in") { - el[, 1:2] <- el[, c(2, 1)] - } else if (mode %in% c("all", "total")) { - reversed_el <- el[, c(2, 1, 3)] - names(reversed_el) <- names(el) - el <- rbind(el, reversed_el) - } - - 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) - res <- set_vertex_attr(res, "type", value = c(rep(FALSE, n1), rep(TRUE, n2))) + if (inherits(incidence, "Matrix")) { + # General Sparse matrix processing + edge_list <- process.sparse(incidence, num_rows) + } else if (!is.null(weighted)) { + # Dense weighted matrix processing + edge_list <- process.dense(incidence, num_rows) } else { - mode(incidence) <- "double" - on.exit(.Call(R_igraph_finalizer)) - ## Function call - mode <- switch(mode, + # 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, multiple) - res <- set_vertex_attr(res$graph, "type", value = res$types) + incidence <- incidence * 1.0 # TODO: check why integer fails below + res <- .Call(R_igraph_biadjacency, incidence, directed, mode_num, multiple) + return(set_vertex_attr(res$graph, "type", value = res$types)) } - res + # Adjust edgelist for directionality and mode + edge_list <- adjust.directionality(edge_list, mode, directed) + + # Handle weights or replicate rows for multiple edges + if (!is.null(weighted)) { + res <- make_empty_graph(n = num_rows + num_cols, directed = directed) + weight_attr <- list(edge_list[, 3]) + names(weight_attr) <- weighted + res <- add_edges(res, edges = t(edge_list[, 1:2]), attr = weight_attr) + } else { + edge_list <- edge_list[rep(seq_len(nrow(edge_list)), times = edge_list[, 3]), 1:2] + res <- make_graph(n = num_rows + num_cols, c(t(edge_list)), directed = directed) + } + + # 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 @@ -227,19 +206,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(incidence, + directed = directed, + mode = mode, multiple = multiple, + weighted = weighted + ) ## Add names if (is.null(add.names)) { From bcce4598de94c27b4a8cab7597b96ad710e39821 Mon Sep 17 00:00:00 2001 From: schochastics Date: Wed, 15 Jan 2025 06:10:19 +0100 Subject: [PATCH 06/13] rename graph.incidence and some variables --- R/incidence.R | 52 ++++++++++++++++++++++++++------------------------- 1 file changed, 27 insertions(+), 25 deletions(-) diff --git a/R/incidence.R b/R/incidence.R index e88d069f994..e55795803c3 100644 --- a/R/incidence.R +++ b/R/incidence.R @@ -35,50 +35,51 @@ graph.incidence <- function(incidence, directed = FALSE, mode = c("all", "out", ## 02110-1301 USA ## ## ----------------------------------------------------------------- + # Helper function to process sparse matrices process.sparse <- function(incidence, num_rows) { - edge_list <- igraph:::mysummary(incidence) # TODO: remove mysummary? - edge_list[, 2] <- edge_list[, 2] + num_rows - as.matrix(edge_list) + el <- mysummary(incidence) + el[, 2] <- el[, 2] + num_rows + as.matrix(el) } # Helper function to process dense matrices process.dense <- function(incidence, num_rows) { - nonzero_indices <- which(incidence != 0, arr.ind = TRUE) - nonzero_indices <- nonzero_indices[order(nonzero_indices[, 1], nonzero_indices[, 2]), , drop = FALSE] - edge_list <- cbind(nonzero_indices, incidence[nonzero_indices]) - edge_list[, 2] <- edge_list[, 2] + num_rows - edge_list + nz_ids <- which(incidence != 0, arr.ind = TRUE) + nz_ids <- nz_ids[order(nz_ids[, 1], nz_ids[, 2]), , drop = FALSE] + el <- cbind(nz_ids, incidence[nz_ids]) + el[, 2] <- el[, 2] + num_rows + el } -adjust.directionality <- function(edge_list, mode, directed) { +adjust.directionality <- function(el, mode, directed) { if (!directed || mode == "out") { # No adjustment needed - return(edge_list) + return(el) } else if (mode == "in") { # Reverse the edges - edge_list[, 1:2] <- edge_list[, c(2, 1)] + el[, 1:2] <- el[, c(2, 1)] } else if (mode %in% c("all", "total")) { # Add reversed edges - reversed_edges <- edge_list[, c(2, 1, 3)] - edge_list <- rbind(edge_list, reversed_edges) + reversed_edges <- el[, c(2, 1, 3)] + el <- rbind(el, reversed_edges) } - edge_list + el } -graph.incidence <- function(incidence, directed = FALSE, mode = "out", - multiple = FALSE, weighted = NULL) { +graph.incidence.build <- function(incidence, directed = FALSE, mode = "out", + multiple = FALSE, weighted = NULL) { num_rows <- nrow(incidence) num_cols <- ncol(incidence) if (inherits(incidence, "Matrix")) { # General Sparse matrix processing - edge_list <- process.sparse(incidence, num_rows) + el <- process.sparse(incidence, num_rows) } else if (!is.null(weighted)) { # Dense weighted matrix processing - edge_list <- process.dense(incidence, num_rows) + el <- process.dense(incidence, num_rows) } else { - # Dense unweighted matrix (potentially with multiple edges + # Dense unweighted matrix (potentially with multiple edges) mode_num <- switch(mode, "out" = 1, "in" = 2, @@ -91,17 +92,18 @@ graph.incidence <- function(incidence, directed = FALSE, mode = "out", } # Adjust edgelist for directionality and mode - edge_list <- adjust.directionality(edge_list, mode, directed) + el <- adjust.directionality(el, mode, directed) # Handle weights or replicate rows for multiple edges if (!is.null(weighted)) { res <- make_empty_graph(n = num_rows + num_cols, directed = directed) - weight_attr <- list(edge_list[, 3]) + weight_attr <- list(el[, 3]) names(weight_attr) <- weighted - res <- add_edges(res, edges = t(edge_list[, 1:2]), attr = weight_attr) + res <- add_edges(res, edges = t(el[, 1:2]), attr = weight_attr) } else { - edge_list <- edge_list[rep(seq_len(nrow(edge_list)), times = edge_list[, 3]), 1:2] - res <- make_graph(n = num_rows + num_cols, c(t(edge_list)), directed = directed) + # 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) } # Set vertex attributes and return @@ -206,7 +208,7 @@ graph_from_biadjacency_matrix <- function(incidence, directed = FALSE, } } - res <- graph.incidence(incidence, + res <- graph.incidence.build(incidence, directed = directed, mode = mode, multiple = multiple, weighted = weighted From 1bcf00fe2e269bc847908862c5ae1d0e9d3d3780 Mon Sep 17 00:00:00 2001 From: schochastics Date: Wed, 15 Jan 2025 09:17:45 +0100 Subject: [PATCH 07/13] add finalizer call and conversion to double for dense unweighted matrices --- R/incidence.R | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/R/incidence.R b/R/incidence.R index e55795803c3..7355b87de12 100644 --- a/R/incidence.R +++ b/R/incidence.R @@ -36,14 +36,14 @@ graph.incidence <- function(incidence, directed = FALSE, mode = c("all", "out", ## ## ----------------------------------------------------------------- -# Helper function to process sparse matrices +# Helper function to process sparse matrices (matrix to edgelist) process.sparse <- function(incidence, num_rows) { el <- mysummary(incidence) el[, 2] <- el[, 2] + num_rows as.matrix(el) } -# Helper function to process dense matrices +# Helper function to process dense matrices (matrix to edgelist) process.dense <- function(incidence, num_rows) { nz_ids <- which(incidence != 0, arr.ind = TRUE) nz_ids <- nz_ids[order(nz_ids[, 1], nz_ids[, 2]), , drop = FALSE] @@ -52,6 +52,7 @@ process.dense <- function(incidence, num_rows) { el } +# adjust edgelist according to directionality of edges adjust.directionality <- function(el, mode, directed) { if (!directed || mode == "out") { # No adjustment needed @@ -79,6 +80,9 @@ graph.incidence.build <- function(incidence, directed = FALSE, mode = "out", # Dense weighted matrix processing el <- process.dense(incidence, num_rows) } else { + mode(incidence) <- "double" + on.exit(.Call(R_igraph_finalizer)) + # Dense unweighted matrix (potentially with multiple edges) mode_num <- switch(mode, "out" = 1, @@ -86,7 +90,6 @@ graph.incidence.build <- function(incidence, directed = FALSE, mode = "out", "all" = 3, "total" = 3 ) - incidence <- incidence * 1.0 # TODO: check why integer fails below res <- .Call(R_igraph_biadjacency, incidence, directed, mode_num, multiple) return(set_vertex_attr(res$graph, "type", value = res$types)) } From 0efea21a218605d59dcdd435466e23d63fc57711 Mon Sep 17 00:00:00 2001 From: schochastics Date: Wed, 15 Jan 2025 21:30:46 +0100 Subject: [PATCH 08/13] removed row first order and fixed erroneous test --- R/incidence.R | 1 - tests/testthat/_snaps/incidence.md | 2 +- 2 files changed, 1 insertion(+), 2 deletions(-) diff --git a/R/incidence.R b/R/incidence.R index 7355b87de12..e06fe507483 100644 --- a/R/incidence.R +++ b/R/incidence.R @@ -46,7 +46,6 @@ process.sparse <- function(incidence, num_rows) { # Helper function to process dense matrices (matrix to edgelist) process.dense <- function(incidence, num_rows) { nz_ids <- which(incidence != 0, arr.ind = TRUE) - nz_ids <- nz_ids[order(nz_ids[, 1], nz_ids[, 2]), , drop = FALSE] el <- cbind(nz_ids, incidence[nz_ids]) el[, 2] <- el[, 2] + num_rows el diff --git a/tests/testthat/_snaps/incidence.md b/tests/testthat/_snaps/incidence.md index b15badd95f6..2b9e6ff16ad 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 From af27a8fbeabd0757de3917bfbd36e7588c07914b Mon Sep 17 00:00:00 2001 From: schochastics Date: Thu, 16 Jan 2025 10:19:00 +0100 Subject: [PATCH 09/13] convert dense to sparse for edge extraction --- R/incidence.R | 13 +++---------- 1 file changed, 3 insertions(+), 10 deletions(-) diff --git a/R/incidence.R b/R/incidence.R index e06fe507483..5880ca5aaed 100644 --- a/R/incidence.R +++ b/R/incidence.R @@ -39,18 +39,11 @@ graph.incidence <- function(incidence, directed = FALSE, mode = c("all", "out", # Helper function to process sparse matrices (matrix to edgelist) process.sparse <- function(incidence, num_rows) { el <- mysummary(incidence) + # adjust indices for second column to create a second mode el[, 2] <- el[, 2] + num_rows as.matrix(el) } -# Helper function to process dense matrices (matrix to edgelist) -process.dense <- function(incidence, num_rows) { - nz_ids <- which(incidence != 0, arr.ind = TRUE) - el <- cbind(nz_ids, incidence[nz_ids]) - el[, 2] <- el[, 2] + num_rows - el -} - # adjust edgelist according to directionality of edges adjust.directionality <- function(el, mode, directed) { if (!directed || mode == "out") { @@ -76,8 +69,8 @@ graph.incidence.build <- function(incidence, directed = FALSE, mode = "out", # General Sparse matrix processing el <- process.sparse(incidence, num_rows) } else if (!is.null(weighted)) { - # Dense weighted matrix processing - el <- process.dense(incidence, num_rows) + # Dense weighted matrix processing (convert to sparse matrix first) + el <- process.sparse(as(incidence, "dgCMatrix"), num_rows) } else { mode(incidence) <- "double" on.exit(.Call(R_igraph_finalizer)) From 97777869d8814dda2f4a1a4ecb2f409a3d31c350 Mon Sep 17 00:00:00 2001 From: schochastics Date: Thu, 16 Jan 2025 11:33:55 +0100 Subject: [PATCH 10/13] simplified adjust.directionality --- R/incidence.R | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/R/incidence.R b/R/incidence.R index 5880ca5aaed..00ef28ba578 100644 --- a/R/incidence.R +++ b/R/incidence.R @@ -49,15 +49,15 @@ 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")) { + } + reversed_edges <- el[, c(2, 1, 3)] + if (mode == "in") { + return(reversed_edges) + } + if (mode %in% c("all", "total")) { # Add reversed edges - reversed_edges <- el[, c(2, 1, 3)] - el <- rbind(el, reversed_edges) + rbind(el, reversed_edges) } - el } graph.incidence.build <- function(incidence, directed = FALSE, mode = "out", From 0e302ae5f3533bea472bf39b3ae6be604ecab082 Mon Sep 17 00:00:00 2001 From: schochastics Date: Thu, 16 Jan 2025 13:01:57 +0100 Subject: [PATCH 11/13] simplified adjust.directionality --- R/incidence.R | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/R/incidence.R b/R/incidence.R index 00ef28ba578..b225c726823 100644 --- a/R/incidence.R +++ b/R/incidence.R @@ -54,10 +54,7 @@ adjust.directionality <- function(el, mode, directed) { if (mode == "in") { return(reversed_edges) } - if (mode %in% c("all", "total")) { - # Add reversed edges - rbind(el, reversed_edges) - } + rbind(el, reversed_edges) } graph.incidence.build <- function(incidence, directed = FALSE, mode = "out", From 412e6b3fffe89717619fe47315168ebad0385fb6 Mon Sep 17 00:00:00 2001 From: schochastics Date: Thu, 16 Jan 2025 13:07:54 +0100 Subject: [PATCH 12/13] streamlined graph.incidence.build --- R/incidence.R | 24 +++++++++++++----------- 1 file changed, 13 insertions(+), 11 deletions(-) diff --git a/R/incidence.R b/R/incidence.R index b225c726823..52497a3e1f2 100644 --- a/R/incidence.R +++ b/R/incidence.R @@ -62,17 +62,11 @@ graph.incidence.build <- function(incidence, directed = FALSE, mode = "out", num_rows <- nrow(incidence) num_cols <- ncol(incidence) - 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 { + # Handle dense unweighted matrices first + if (!inherits(incidence, "Matrix") && is.null(weighted)) { mode(incidence) <- "double" on.exit(.Call(R_igraph_finalizer)) - # Dense unweighted matrix (potentially with multiple edges) mode_num <- switch(mode, "out" = 1, "in" = 2, @@ -83,27 +77,35 @@ graph.incidence.build <- function(incidence, directed = FALSE, mode = "out", return(set_vertex_attr(res$graph, "type", value = res$types)) } + # Convert to sparse matrix if not already sparse + if (!inherits(incidence, "Matrix")) { + incidence <- as(incidence, "dgCMatrix") + } + + # Process sparse matrix to edgelist + el <- process.sparse(incidence, num_rows) # Adjust edgelist for directionality and mode el <- adjust.directionality(el, mode, directed) - # Handle weights or replicate rows for multiple edges + # 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 { - # create multiple edges according to the third column + # 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) } - # 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 From 40e5011a8ab019eeaeba829cc7688e4159e917c5 Mon Sep 17 00:00:00 2001 From: schochastics Date: Mon, 27 Jan 2025 20:25:14 +0100 Subject: [PATCH 13/13] better helping function naming --- R/incidence.R | 22 ++++++++-------------- 1 file changed, 8 insertions(+), 14 deletions(-) diff --git a/R/incidence.R b/R/incidence.R index 52497a3e1f2..1a727987b6e 100644 --- a/R/incidence.R +++ b/R/incidence.R @@ -36,16 +36,9 @@ graph.incidence <- function(incidence, directed = FALSE, mode = c("all", "out", ## ## ----------------------------------------------------------------- -# Helper function to process sparse matrices (matrix to edgelist) -process.sparse <- function(incidence, num_rows) { - el <- mysummary(incidence) - # adjust indices for second column to create a second mode - el[, 2] <- el[, 2] + num_rows - as.matrix(el) -} # adjust edgelist according to directionality of edges -adjust.directionality <- function(el, mode, directed) { +modify_edgelist <- function(el, mode, directed) { if (!directed || mode == "out") { # No adjustment needed return(el) @@ -57,7 +50,7 @@ adjust.directionality <- function(el, mode, directed) { rbind(el, reversed_edges) } -graph.incidence.build <- function(incidence, directed = FALSE, mode = "out", +graph_incidence_build <- function(incidence, directed = FALSE, mode = "out", multiple = FALSE, weighted = NULL) { num_rows <- nrow(incidence) num_cols <- ncol(incidence) @@ -82,10 +75,11 @@ graph.incidence.build <- function(incidence, directed = FALSE, mode = "out", incidence <- as(incidence, "dgCMatrix") } - # Process sparse matrix to edgelist - el <- process.sparse(incidence, num_rows) - # Adjust edgelist for directionality and mode - el <- adjust.directionality(el, mode, directed) + el <- mysummary(incidence) + el[, 2] <- el[, 2] + num_rows + el <- as.matrix(el) + + el <- modify_edgelist(el, mode, directed) # Construct the graph object from processed edgelist if (!is.null(weighted)) { @@ -202,7 +196,7 @@ graph_from_biadjacency_matrix <- function(incidence, directed = FALSE, } } - res <- graph.incidence.build(incidence, + res <- graph_incidence_build(incidence, directed = directed, mode = mode, multiple = multiple, weighted = weighted