#' Create graphs from adjacency matrices
#'
#' @description
#' `r lifecycle::badge("deprecated")`
#'
#' `graph.adjacency()` was renamed to [graph_from_adjacency_matrix()] to create a more
#' consistent API.
#' @inheritParams graph_from_adjacency_matrix
#' @keywords internal
#' @export
graph.adjacency <- function(
adjmatrix,
mode = c("directed", "undirected", "max", "min", "upper", "lower", "plus"),
weighted = NULL,
diag = TRUE,
add.colnames = NULL,
add.rownames = NA
) {
# nocov start
lifecycle::deprecate_soft(
"2.0.0",
"graph.adjacency()",
"graph_from_adjacency_matrix()"
)
graph_from_adjacency_matrix(
adjmatrix = adjmatrix,
mode = mode,
weighted = weighted,
diag = diag,
add.colnames = add.colnames,
add.rownames = add.rownames
)
} # nocov end
## ----------------------------------------------------------------
##
## IGraph R package
## Copyright (C) 2005-2014 Gabor Csardi <csardi.gabor@gmail.com>
## 334 Harvard street, Cambridge, MA 02139 USA
##
## This program is free software; you can redistribute it and/or modify
## it under the terms of the GNU General Public License as published by
## the Free Software Foundation; either version 2 of the License, or
## (at your option) any later version.
##
## This program is distributed in the hope that it will be useful,
## but WITHOUT ANY WARRANTY; without even the implied warranty of
## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
## GNU General Public License for more details.
##
## You should have received a copy of the GNU General Public License
## along with this program; if not, write to the Free Software
## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
## 02110-1301 USA
##
## -----------------------------------------------------------------
#' Create graphs from adjacency matrices
#'
#' `graph_from_adjacency_matrix()` is a flexible function for creating `igraph`
#' graphs from adjacency matrices.
#'
#' The order of the vertices are preserved, i.e. the vertex corresponding to
#' the first row will be vertex 0 in the graph, etc.
#'
#' `graph_from_adjacency_matrix()` operates in two main modes, depending on the
#' `weighted` argument.
#'
#' If this argument is `NULL` then an unweighted graph is created and an
#' element of the adjacency matrix gives the number of edges to create between
#' the two corresponding vertices. The details depend on the value of the
#' `mode` argument:
#' \describe{
#' \item{"directed"}{
#' The graph will be directed and a matrix element gives
#' the number of edges between two vertices.
#' }
#' \item{"undirected"}{
#' This is exactly the same as `max`, for convenience.
#' Note that it is *not* checked whether the matrix is symmetric.
#' }
#' \item{"max"}{
#' An undirected graph will be created and `max(A(i,j), A(j,i))`
#' gives the number of edges.
#' }
#' \item{"upper"}{
#' An undirected graph will be created, only the upper right triangle
#' (including the diagonal) is used for the number of edges.
#' }
#' \item{"lower"}{
#' An undirected graph will be created, only the lower left triangle
#' (including the diagonal) is used for creating the edges.
#' }
#' \item{"min"}{
#' An undirected graph will be created with `min(A(i,j), A(j,i))` edges
#' between vertex `i` and `j`.
#' }
#' \item{"plus"}{
#' An undirected graph will be created with `A(i,j)+A(j,i)` edges
#' between vertex `i` and `j`.
#' }
#' }
#'
#' If the `weighted` argument is not `NULL` then the elements of the
#' matrix give the weights of the edges (if they are not zero). The details
#' depend on the value of the `mode` argument:
#' \describe{
#' \item{"directed"}{
#' The graph will be directed and a matrix element gives the edge weights.
#' }
#' \item{"undirected"}{
#' First we check that the matrix is symmetric. It is an error if not.
#' Then only the upper triangle is used to create a weighted undirected graph.
#' }
#' \item{"max"}{
#' An undirected graph will be created and `max(A(i,j), A(j,i))`
#' gives the edge weights.
#' }
#' \item{"upper"}{
#' An undirected graph will be created, only the upper right triangle
#' (including the diagonal) is used (for the edge weights).
#' }
#' \item{"lower"}{
#' An undirected graph will be created, only the lower left triangle
#' (including the diagonal) is used for creating the edges.
#' }
#' \item{"min"}{
#' An undirected graph will be created, `min(A(i,j), A(j,i))`
#' gives the edge weights.
#' }
#' \item{"plus"}{
#' An undirected graph will be created, `A(i,j)+A(j,i)`
#' gives the edge weights.
#' }
#' }
#'
#' @param adjmatrix A square adjacency matrix. From igraph version 0.5.1 this
#' can be a sparse matrix created with the `Matrix` package.
#' @param mode Character scalar, specifies how igraph should interpret the
#' supplied matrix. See also the `weighted` argument, the interpretation
#' depends on that too. Possible values are: `directed`,
#' `undirected`, `upper`, `lower`, `max`, `min`,
#' `plus`. See details below.
#' @param weighted This argument specifies whether to create a weighted graph
#' from an adjacency matrix. If it is `NULL` then an unweighted graph is
#' created and the elements of the adjacency matrix gives the number of edges
#' between the vertices. If it is a character constant then for every non-zero
#' matrix entry an edge is created and the value of the entry is added as an
#' edge attribute named by the `weighted` argument. If it is `TRUE`
#' then a weighted graph is created and the name of the edge attribute will be
#' `weight`. See also details below.
#' @param diag Logical scalar, whether to include the diagonal of the matrix in
#' the calculation. If this is `FALSE` then the diagonal is zerod out
#' first.
#' @param add.colnames Character scalar, whether to add the column names as
#' vertex attributes. If it is \sQuote{`NULL`} (the default) then, if
#' present, column names are added as vertex attribute \sQuote{name}. If
#' \sQuote{`NA`} then they will not be added. If a character constant,
#' then it gives the name of the vertex attribute to add.
#' @param add.rownames Character scalar, whether to add the row names as vertex
#' attributes. Possible values the same as the previous argument. By default
#' row names are not added. If \sQuote{`add.rownames`} and
#' \sQuote{`add.colnames`} specify the same vertex attribute, then the
#' former is ignored.
#' @return An igraph graph object.
#' @author Gabor Csardi \email{csardi.gabor@@gmail.com}
#' @seealso [make_graph()] and [graph_from_literal()] for other ways to
#' create graphs.
#' @keywords graphs
#' @examples
#'
#' g1 <- sample(
#' x = 0:1, size = 100, replace = TRUE,
#' prob = c(0.9, 0.1)
#' ) %>%
#' matrix(ncol = 10) %>%
#' graph_from_adjacency_matrix()
#'
#' g2 <- sample(
#' x = 0:5, size = 100, replace = TRUE,
#' prob = c(0.9, 0.02, 0.02, 0.02, 0.02, 0.02)
#' ) %>%
#' matrix(ncol = 10) %>%
#' graph_from_adjacency_matrix(weighted = TRUE)
#' E(g2)$weight
#'
#' ## various modes for weighted graphs, with some tests
#' non_zero_sort <- function(x) sort(x[x != 0])
#' adj_matrix <- matrix(runif(100), 10)
#' adj_matrix[adj_matrix < 0.5] <- 0
#' g3 <- graph_from_adjacency_matrix(
#' (adj_matrix + t(adj_matrix)) / 2,
#' weighted = TRUE,
#' mode = "undirected"
#' )
#'
#' g4 <- graph_from_adjacency_matrix(
#' adj_matrix,
#' weighted = TRUE,
#' mode = "max"
#' )
#' expected_g4_weights <- non_zero_sort(
#' pmax(adj_matrix, t(adj_matrix))[upper.tri(adj_matrix, diag = TRUE)]
#' )
#' actual_g4_weights <- sort(E(g4)$weight)
#' all(expected_g4_weights == actual_g4_weights)
#'
#' g5 <- graph_from_adjacency_matrix(
#' adj_matrix,
#' weighted = TRUE,
#' mode = "min"
#' )
#' expected_g5_weights <- non_zero_sort(
#' pmin(adj_matrix, t(adj_matrix))[upper.tri(adj_matrix, diag = TRUE)]
#' )
#' actual_g5_weights <- sort(E(g5)$weight)
#' all(expected_g5_weights == actual_g5_weights)
#'
#' g6 <- graph_from_adjacency_matrix(
#' adj_matrix,
#' weighted = TRUE,
#' mode = "upper"
#' )
#' expected_g6_weights <- non_zero_sort(adj_matrix[upper.tri(adj_matrix, diag = TRUE)])
#' actual_g6_weights <- sort(E(g6)$weight)
#' all(expected_g6_weights == actual_g6_weights)
#'
#' g7 <- graph_from_adjacency_matrix(
#' adj_matrix,
#' weighted = TRUE,
#' mode = "lower"
#' )
#' expected_g7_weights <- non_zero_sort(adj_matrix[lower.tri(adj_matrix, diag = TRUE)])
#' actual_g7_weights <- sort(E(g7)$weight)
#' all(expected_g7_weights == actual_g7_weights)
#'
#' g8 <- graph_from_adjacency_matrix(
#' adj_matrix,
#' weighted = TRUE,
#' mode = "plus"
#' )
#' halve_diag <- function(x) {
#' diag(x) <- diag(x) / 2
#' x
#' }
#' expected_g8_weights <- non_zero_sort(
#' halve_diag(adj_matrix + t(adj_matrix))[lower.tri(adj_matrix, diag = TRUE)]
#' )
#' actual_g8_weights <- sort(E(g8)$weight)
#' all(expected_g8_weights == actual_g8_weights)
#'
#' g9 <- graph_from_adjacency_matrix(
#' adj_matrix,
#' weighted = TRUE,
#' mode = "plus",
#' diag = FALSE
#' )
#' zero_diag <- function(x) {
#' diag(x) <- 0
#' }
#' expected_g9_weights <- non_zero_sort((zero_diag(adj_matrix + t(adj_matrix)))[lower.tri(adj_matrix)])
#' actual_g9_weights <- sort(E(g9)$weight)
#' all(expected_g9_weights == actual_g9_weights)
#'
#' ## row/column names
#' rownames(adj_matrix) <- sample(letters, nrow(adj_matrix))
#' colnames(adj_matrix) <- seq(ncol(adj_matrix))
#' g10 <- graph_from_adjacency_matrix(
#' adj_matrix,
#' weighted = TRUE,
#' add.rownames = "code"
#' )
#' summary(g10)
#'
#' @export
graph_from_adjacency_matrix <- function(
adjmatrix,
mode = c(
"directed",
"undirected",
"max",
"min",
"upper",
"lower",
"plus"
),
weighted = NULL,
diag = TRUE,
add.colnames = NULL,
add.rownames = NA
) {
ensure_no_na(adjmatrix, "adjacency matrix")
mode <- igraph.match.arg(mode)
if (!is.matrix(adjmatrix) && !inherits(adjmatrix, "Matrix")) {
lifecycle::deprecate_soft(
"1.6.0",
"graph_from_adjacency_matrix(adjmatrix = 'must be a matrix')"
)
adjmatrix <- as.matrix(1)
}
if (mode == "undirected") {
if (!is_symmetric(adjmatrix)) {
lifecycle::deprecate_soft(
"1.6.0",
"graph_from_adjacency_matrix(adjmatrix = 'must be symmetric with mode = \"undirected\"')",
details = 'Use mode = "max" to achieve the original behavior.'
)
mode <- "max"
}
}
if (inherits(adjmatrix, "Matrix")) {
res <- graph.adjacency.sparse(
adjmatrix,
mode = mode,
weighted = weighted,
diag = diag
)
} else {
res <- graph.adjacency.dense(
adjmatrix,
mode = mode,
weighted = weighted,
diag = diag
)
}
## Add columns and row names as attributes
if (is.null(add.colnames)) {
if (!is.null(colnames(adjmatrix))) {
add.colnames <- "name"
} else {
add.colnames <- NA
}
} else if (!is.na(add.colnames)) {
if (is.null(colnames(adjmatrix))) {
cli::cli_warn("No column names to add")
add.colnames <- NA
}
}
if (is.null(add.rownames)) {
if (!is.null(rownames(adjmatrix))) {
add.rownames <- "name"
} else {
add.colnames <- NA
}
} else if (!is.na(add.rownames)) {
if (is.null(rownames(adjmatrix))) {
cli::cli_warn("No row names to add")
add.rownames <- NA
}
}
if (
!is.na(add.rownames) && !is.na(add.colnames) && add.rownames == add.colnames
) {
cli::cli_warn("Same attribute for columns and rows, row names are ignored")
add.rownames <- NA
}
if (!is.na(add.colnames)) {
res <- set_vertex_attr(res, add.colnames, value = colnames(adjmatrix))
}
if (!is.na(add.rownames)) {
res <- set_vertex_attr(res, add.rownames, value = rownames(adjmatrix))
}
res
}
is_symmetric <- function(x) {
if (inherits(x, "Matrix")) {
return(Matrix::isSymmetric(x, tol = 0, tol1 = 0))
}
if (is.matrix(x)) {
return(isSymmetric.matrix(x, tol = 0, tol1 = 0))
}
return(isSymmetric(x, tol = 0, tol1 = 0))
}
#' @rdname graph_from_adjacency_matrix
#' @param ... Passed to `graph_from_adjacency_matrix()`.
#' @family adjacency
#' @export
from_adjacency <- function(...) {
constructor_spec(graph_from_adjacency_matrix, ...)
}
graph.adjacency.dense <- function(
adjmatrix,
mode,
weighted = NULL,
diag = c("once", "twice", "ignore")
) {
mode <- switch(
mode,
"directed" = 0L,
"undirected" = 1L,
"upper" = 2L,
"lower" = 3L,
"min" = 4L,
"plus" = 5L,
"max" = 6L
)
if (is.logical(diag)) {
diag <- ifelse(diag, "once", "ignore")
}
diag <- igraph.match.arg(diag)
diag <- switch(diag, "ignore" = 0L, "twice" = 1L, "once" = 2L)
if (nrow(adjmatrix) != ncol(adjmatrix)) {
stop("Adjacency matrices must be square.")
}
mode(adjmatrix) <- "double"
if (isTRUE(weighted)) {
weighted <- "weight"
} else if (!is.character(weighted)) {
weighted <- NULL
}
on.exit(.Call(R_igraph_finalizer))
if (is.null(weighted)) {
res <- .Call(R_igraph_adjacency, adjmatrix, mode, diag)
} else {
res <- .Call(R_igraph_weighted_adjacency, adjmatrix, mode, diag)
res <- set_edge_attr(res$graph, weighted, value = res$weights)
}
res
}
## helper function to replace Matrix::summary() in a way that ensures that we
## have a third column even when Matrix::summary() returned the non-zero
## cell coordinates only
mysummary <- function(x) {
result <- Matrix::summary(x)
if (ncol(result) < 3) {
result <- cbind(result, 1)
}
result
}
pmax_AB <- function(A, B) {
change <- A < B
A[change] <- B[change]
A
}
pmin_AB <- function(A, B) {
change <- A > B
A[change] <- B[change]
A
}
graph.adjacency.sparse <- function(
adjmatrix,
mode,
weighted = NULL,
diag = TRUE,
call = rlang::caller_env()
) {
if (!is.null(weighted)) {
if (is.logical(weighted) && weighted) {
weighted <- "weight"
}
if (!is.character(weighted)) {
cli::cli_abort(
"Invalid value supplied for `weighted' argument, please see docs.",
call = call
)
}
}
if (nrow(adjmatrix) != ncol(adjmatrix)) {
cli::cli_abort("Not a square matrix", call = call)
}
vc <- nrow(adjmatrix)
# Exit early for empty graphs
if (vc == 1 || Matrix::nnzero(adjmatrix) == 0) {
return(make_empty_graph(n = vc, directed = (mode == "directed")))
}
if (inherits(adjmatrix, "dgTMatrix")) {
adjmatrix <- as(adjmatrix, "CsparseMatrix")
} else if (inherits(adjmatrix, "ddiMatrix")) {
adjmatrix <- as(adjmatrix, "CsparseMatrix")
}
if (mode == "undirected") {
if (!is.null(weighted) && !Matrix::isSymmetric(adjmatrix)) {
cli::cli_abort(
"Please supply a symmetric matrix if you want to create a weighted graph with mode=UNDIRECTED.",
call = call
)
}
adjmatrix <- Matrix::tril(adjmatrix)
} else if (mode == "lower") {
adjmatrix <- Matrix::tril(adjmatrix)
} else if (mode == "upper") {
adjmatrix <- Matrix::triu(adjmatrix)
} else if (mode == "plus") {
adjmatrix <- adjmatrix + Matrix::t(adjmatrix)
adjmatrix <- Matrix::tril(adjmatrix)
} else if (mode == "max") {
adjmatrix <- pmax_AB(
Matrix::tril(adjmatrix),
Matrix::t(Matrix::triu(adjmatrix))
)
} else if (mode == "min") {
adjmatrix <- pmin_AB(
Matrix::tril(adjmatrix),
Matrix::t(Matrix::triu(adjmatrix))
)
adjmatrix <- Matrix::drop0(adjmatrix)
}
el <- mysummary(adjmatrix)
if (!diag) {
el <- el[el[, 1] != el[, 2], ]
}
if (!is.null(weighted)) {
res <- make_empty_graph(n = vc, directed = (mode == "directed"))
weight <- list(el[, 3])
names(weight) <- weighted
res <- add_edges(res, edges = t(as.matrix(el[, 1:2])), attr = weight)
} else {
if (max(el[, 3]) == 1) {
edges <- as.vector(t(el[, 1:2]))
} else {
row_repeats <- rep(seq_len(nrow(el)), times = el[, 3])
edges <- as.vector(t(el[row_repeats, 1:2]))
}
res <- make_graph(n = vc, edges, directed = (mode == "directed"))
}
res
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.