From 0bc345dfa5bfafba69f747875fee69d3646163e2 Mon Sep 17 00:00:00 2001 From: schochastics Date: Fri, 20 Sep 2024 21:06:59 +0200 Subject: [PATCH 1/7] removed for loops in get.adjacency.dense --- R/conversion.R | 63 ++++++++------------------------------------------ 1 file changed, 9 insertions(+), 54 deletions(-) diff --git a/R/conversion.R b/R/conversion.R index ec548d01291..f31e47c5b4a 100644 --- a/R/conversion.R +++ b/R/conversion.R @@ -1,4 +1,3 @@ - #' Convert igraph graphs to graphNEL objects from the graph package #' #' @description @@ -159,11 +158,6 @@ get.adjacency.dense <- function(graph, type = c("both", "upper", "lower"), ensure_igraph(graph) type <- igraph.match.arg(type) - type <- switch(type, - "upper" = 0, - "lower" = 1, - "both" = 2 - ) if (is.logical(loops)) { loops <- ifelse(loops, "once", "ignore") @@ -183,61 +177,22 @@ get.adjacency.dense <- function(graph, type = c("both", "upper", "lower"), if (is.null(attr)) { on.exit(.Call(R_igraph_finalizer)) + type <- switch(type, + "upper" = 0, + "lower" = 1, + "both" = 2 + ) res <- .Call( R_igraph_get_adjacency, graph, as.numeric(type), weights, loops ) } else { - attr <- as.character(attr) - if (!attr %in% edge_attr_names(graph)) { - stop("no such edge attribute") - } - exattr <- edge_attr(graph, attr) - if (is.logical(exattr)) { - res <- matrix(FALSE, nrow = vcount(graph), ncol = vcount(graph)) - } else if (is.numeric(exattr)) { - res <- matrix(0, nrow = vcount(graph), ncol = vcount(graph)) - } else { - stop( - "Matrices must be either numeric or logical, ", - "and the edge attribute is not" - ) - } - if (is_directed(graph)) { - for (i in seq(length.out = ecount(graph))) { - e <- ends(graph, i, names = FALSE) - res[e[1], e[2]] <- exattr[i] - } - } else { - if (type == 0) { - ## upper - for (i in seq(length.out = ecount(graph))) { - e <- ends(graph, i, names = FALSE) - res[min(e), max(e)] <- exattr[i] - } - } else if (type == 1) { - ## lower - for (i in seq(length.out = ecount(graph))) { - e <- ends(graph, i, names = FALSE) - res[max(e), min(e)] <- exattr[i] - } - } else if (type == 2) { - ## both - for (i in seq(length.out = ecount(graph))) { - e <- ends(graph, i, names = FALSE) - res[e[1], e[2]] <- exattr[i] - if (e[1] != e[2]) { - res[e[2], e[1]] <- exattr[i] - } - } - } - } + res <- as.matrix(get.adjacency.sparse(graph, type = type, attr = attr, names = names)) } if (names && "name" %in% vertex_attr_names(graph)) { colnames(res) <- rownames(res) <- V(graph)$name } - res } @@ -1004,7 +959,7 @@ get.incidence.sparse <- function(graph, types, names, attr) { #' as_biadjacency_matrix(g) #' as_biadjacency_matrix <- function(graph, types = NULL, attr = NULL, - names = TRUE, sparse = FALSE) { + names = TRUE, sparse = FALSE) { # Argument checks ensure_igraph(graph) types <- handle_vertex_type_arg(types, graph) @@ -1033,8 +988,8 @@ as_biadjacency_matrix <- function(graph, types = NULL, attr = NULL, #' this naming to avoid confusion with the edge-vertex incidence matrix. #' @export as_incidence_matrix <- function(...) { # nocov start - lifecycle::deprecate_soft("1.6.0", "as_incidence_matrix()", "as_biadjacency_matrix()") - as_biadjacency_matrix(...) + lifecycle::deprecate_soft("1.6.0", "as_incidence_matrix()", "as_biadjacency_matrix()") + as_biadjacency_matrix(...) } # nocov end #' @rdname graph_from_data_frame #' @param x An igraph object. From 041161100e720b0dbd727d268a804bd6bb1d5dd5 Mon Sep 17 00:00:00 2001 From: schochastics Date: Sat, 21 Sep 2024 07:31:50 +0200 Subject: [PATCH 2/7] 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 d53f3de3da79f9657243ec30e03271aa8463f53b Mon Sep 17 00:00:00 2001 From: schochastics Date: Sat, 21 Sep 2024 21:40:59 +0200 Subject: [PATCH 3/7] removed for loops from get.incidence.dense --- R/conversion.R | 17 ++++++++--------- 1 file changed, 8 insertions(+), 9 deletions(-) diff --git a/R/conversion.R b/R/conversion.R index f31e47c5b4a..d8e3993fbe5 100644 --- a/R/conversion.R +++ b/R/conversion.R @@ -845,15 +845,14 @@ get.incidence.dense <- function(graph, types, names, attr) { recode[!types] <- seq_len(n1) recode[types] <- seq_len(n2) - for (i in seq(length.out = ecount(graph))) { - eo <- ends(graph, i, names = FALSE) - e <- recode[eo] - if (!types[eo[1]]) { - res[e[1], e[2]] <- edge_attr(graph, attr, i) - } else { - res[e[2], e[1]] <- edge_attr(graph, attr, i) - } - } + el <- as_edgelist(graph, names = FALSE) + idx <- types[el[, 1]] + el[, 1] <- recode[el[, 1]] + el[, 2] <- recode[el[, 2]] + + tmp <- el[idx, 2:1] + el[idx, ] <- tmp + res[el] <- edge_attr(graph, attr) if (names && "name" %in% vertex_attr_names(graph)) { rownames(res) <- V(graph)$name[which(!types)] From 46293f9311e0fa66eaa8f99d65f8601a1f02f10d Mon Sep 17 00:00:00 2001 From: schochastics Date: Wed, 9 Oct 2024 21:01:38 +0200 Subject: [PATCH 4/7] added comment that as.matrix on sparse adj is fastest solution --- R/conversion.R | 1 + 1 file changed, 1 insertion(+) diff --git a/R/conversion.R b/R/conversion.R index d8e3993fbe5..8d37bf7240b 100644 --- a/R/conversion.R +++ b/R/conversion.R @@ -187,6 +187,7 @@ get.adjacency.dense <- function(graph, type = c("both", "upper", "lower"), loops ) } else { + # faster than a specialized implementation res <- as.matrix(get.adjacency.sparse(graph, type = type, attr = attr, names = names)) } From 7a7ed0342485e6869b417ec0c93723d430d60405 Mon Sep 17 00:00:00 2001 From: schochastics Date: Wed, 9 Oct 2024 21:25:46 +0200 Subject: [PATCH 5/7] refactor and added comments to get.incidence.dense --- R/conversion.R | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) diff --git a/R/conversion.R b/R/conversion.R index 8d37bf7240b..a387c3da37c 100644 --- a/R/conversion.R +++ b/R/conversion.R @@ -334,7 +334,6 @@ as_adjacency_matrix <- function(graph, type = c("both", "upper", "lower"), as_adj <- function(graph, type = c("both", "upper", "lower"), attr = NULL, edges = deprecated(), names = TRUE, sparse = igraph_opt("sparsematrices")) { - lifecycle::deprecate_soft("2.1.0", "as_adj()", "as_adjacency_matrix()") as_adjacency_matrix( @@ -843,16 +842,21 @@ get.incidence.dense <- function(graph, types, names, attr) { res <- matrix(0, n1, n2) recode <- numeric(vc) + # move from 1..n indexing to 1..n1 row indices for type == FALSE + # and 1..n2 col indices for type == TRUE + # recode holds the mapping [1..n] -> [1..n1,1..n2] recode[!types] <- seq_len(n1) recode[types] <- seq_len(n2) el <- as_edgelist(graph, names = FALSE) idx <- types[el[, 1]] - el[, 1] <- recode[el[, 1]] - el[, 2] <- recode[el[, 2]] + el[] <- recode[el] - tmp <- el[idx, 2:1] - el[idx, ] <- tmp + # switch order of source/target such that nodes with + # type == FALSE are in el[ ,1] + el[idx, ] <- el[idx, 2:1] + # el[ ,1] only holds values 1..n1 and el[ ,2] values 1..n2 + # and we can populate the matrix res[el] <- edge_attr(graph, attr) if (names && "name" %in% vertex_attr_names(graph)) { From 76d019fa935240179611e67b54ec7d692ffbbd24 Mon Sep 17 00:00:00 2001 From: schochastics Date: Wed, 9 Oct 2024 21:34:57 +0200 Subject: [PATCH 6/7] 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 a1799e337af3f73f5e37b55459faadf5a123a944 Mon Sep 17 00:00:00 2001 From: schochastics Date: Wed, 9 Oct 2024 21:49:14 +0200 Subject: [PATCH 7/7] 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)) {