Skip to content
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

Jump to bottom

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

Open
wants to merge 7 commits into
base: main
Choose a base branch
from
Open

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
b71b454
removed for loops in get.adjacency.dense
schochastics Sep 20, 2024
df6796f
removed for loops in graph.incidence.dense
schochastics Sep 21, 2024
934c5ec
removed for loops from get.incidence.dense
schochastics Sep 21, 2024
419e032
added comment that as.matrix on sparse adj is fastest solution
schochastics Oct 9, 2024
736ce10
refactor and added comments to get.incidence.dense
schochastics Oct 9, 2024
764bf3e
added comments to graph.incidence.sparse
schochastics Oct 9, 2024
12c9a27
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))
}
schochastics marked this conversation as resolved.
Show resolved Hide resolved

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