Skip to content

refactor: remove for loops from weighted dense matrix creation (#1483) #1518

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Closed
wants to merge 7 commits into from
Closed

refactor: remove for loops from weighted dense matrix creation (#1483) #1518

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
7 commits
Select commit Hold shift + click to select a range
0bc345d
removed for loops in get.adjacency.dense
schochastics Sep 20, 2024
0411611
removed for loops in graph.incidence.dense
schochastics Sep 21, 2024
d53f3de
removed for loops from get.incidence.dense
schochastics Sep 21, 2024
46293f9
added comment that as.matrix on sparse adj is fastest solution
schochastics Oct 9, 2024
7a7ed03
refactor and added comments to get.incidence.dense
schochastics Oct 9, 2024
76d019f
added comments to graph.incidence.sparse
schochastics Oct 9, 2024
a1799e3
moved mode recoding from graph_from_biadjacency_matrix into subroutines
schochastics Oct 9, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
87 changes: 23 additions & 64 deletions R/conversion.R
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,4 +1,3 @@

#' Convert igraph graphs to graphNEL objects from the graph package
#'
#' @description
Expand Down Expand Up @@ -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")
Expand All @@ -183,61 +177,23 @@ 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]
}
}
}
}
# faster than a specialized implementation
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
}

Expand Down Expand Up @@ -378,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(
Expand Down Expand Up @@ -887,18 +842,22 @@ 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)

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[] <- recode[el]

# 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)) {
rownames(res) <- V(graph)$name[which(!types)]
Expand Down Expand Up @@ -1004,7 +963,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)
Expand Down Expand Up @@ -1033,8 +992,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.
Expand Down
104 changes: 44 additions & 60 deletions R/incidence.R
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,4 +1,3 @@

#' Create graphs from a bipartite adjacency matrix
#'
#' @description
Expand Down Expand Up @@ -45,12 +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)
Expand All @@ -68,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)])
}

Expand All @@ -86,60 +84,51 @@ 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)
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
}
}
}

# 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 == "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(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))
## 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)
}

res
}


#' Create graphs from a bipartite adjacency matrix
#'
#' `graph_from_biadjacency_matrix()` creates a bipartite igraph graph from an incidence
Expand Down Expand Up @@ -203,22 +192,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}.",
Expand Down Expand Up @@ -290,8 +274,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
#'
Expand All @@ -308,6 +292,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
Loading