From c7e627dfe64fdf72f9d40cbcc15809277b5dcc5d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ma=C3=ABlle=20Salmon?= Date: Mon, 23 Sep 2024 15:52:06 +0200 Subject: [PATCH] chore: start deprecation of `as_adj()` alias of `as_adjacency_matrix()` --- R/centrality.R | 16 +++--- R/conversion.R | 32 ++++++++--- R/indexing.R | 16 +++--- R/stochastic_matrix.R | 2 +- demo/community.R | 2 +- man/arpack.Rd | 2 +- man/as_adj.Rd | 54 +++++++++++++++++++ man/as_adj_list.Rd | 2 +- man/as_adjacency_matrix.Rd | 10 ---- man/as_graphnel.Rd | 2 +- man/graph_from_graphnel.Rd | 2 +- man/spectrum.Rd | 4 +- man/stochastic_matrix.Rd | 2 +- tests/testthat/test-authority.score.R | 20 +++---- tests/testthat/test-centrality.R | 4 +- tests/testthat/test-evcent.R | 2 +- tests/testthat/test-get.adjacency.R | 8 +-- tests/testthat/test-graph.eigen.R | 2 +- tests/testthat/test-graphNEL.R | 4 +- .../test-leading.eigenvector.community.R | 2 +- tests/testthat/test-structural.properties.R | 2 +- 21 files changed, 127 insertions(+), 63 deletions(-) create mode 100644 man/as_adj.Rd diff --git a/R/centrality.R b/R/centrality.R index eef98fb8a9..29b1737a87 100644 --- a/R/centrality.R +++ b/R/centrality.R @@ -673,7 +673,7 @@ arpack_defaults <- function() { #' if (require(Matrix)) { #' set.seed(42) #' g <- sample_gnp(1000, 5 / 1000) -#' M <- as_adj(g, sparse = TRUE) +#' M <- as_adjacency_matrix(g, sparse = TRUE) #' f2 <- function(x, extra = NULL) { #' cat(".") #' as.vector(M %*% x) @@ -800,7 +800,7 @@ arpack.unpack.complex <- function(vectors, values, nev) { #' cor(degree(g), sc) #' subgraph_centrality <- function(graph, diag = FALSE) { - A <- as_adj(graph) + A <- as_adjacency_matrix(graph) if (!diag) { diag(A) <- 0 } @@ -860,7 +860,7 @@ subgraph_centrality <- function(graph, diag = FALSE) { #' \item{values}{Numeric vector, the eigenvalues.} \item{vectors}{Numeric #' matrix, with the eigenvectors as columns.} #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} -#' @seealso [as_adj()] to create a (sparse) adjacency matrix. +#' @seealso [as_adjacency_matrix()] to create a (sparse) adjacency matrix. #' @keywords graphs #' @examples #' @@ -869,7 +869,7 @@ subgraph_centrality <- function(graph, diag = FALSE) { #' spectrum(kite)[c("values", "vectors")] #' #' ## Double check -#' eigen(as_adj(kite, sparse = FALSE))$vectors[, 1] +#' eigen(as_adjacency_matrix(kite, sparse = FALSE))$vectors[, 1] #' #' ## Should be the same as 'eigen_centrality' (but rescaled) #' cor(eigen_centrality(kite)$vector, spectrum(kite)$vectors) @@ -1361,7 +1361,7 @@ bonpow.dense <- function(graph, nodes = V(graph), rescale = FALSE, tol = 1e-7) { ensure_igraph(graph) - d <- as_adj(graph) + d <- as_adjacency_matrix(graph) if (!loops) { diag(d) <- 0 } @@ -1389,7 +1389,7 @@ bonpow.sparse <- function(graph, nodes = V(graph), loops = FALSE, vg <- vcount(graph) ## sparse adjacency matrix - d <- as_adj(graph, sparse = TRUE) + d <- as_adjacency_matrix(graph, sparse = TRUE) ## sparse identity matrix id <- as(Matrix::Matrix(diag(vg), doDiag = FALSE), "generalMatrix") @@ -1564,7 +1564,7 @@ alpha.centrality.dense <- function(graph, nodes = V(graph), alpha = 1, attr <- NULL } - d <- t(as_adj(graph, attr = attr, sparse = FALSE)) + d <- t(as_adjacency_matrix(graph, attr = attr, sparse = FALSE)) if (!loops) { diag(d) <- 0 } @@ -1605,7 +1605,7 @@ alpha.centrality.sparse <- function(graph, nodes = V(graph), alpha = 1, attr <- NULL } - M <- Matrix::t(as_adj(graph, attr = attr, sparse = TRUE)) + M <- Matrix::t(as_adjacency_matrix(graph, attr = attr, sparse = TRUE)) ## Create an identity matrix M2 <- Matrix::sparseMatrix(dims = c(vc, vc), i = 1:vc, j = 1:vc, x = rep(1, vc)) diff --git a/R/conversion.R b/R/conversion.R index 03c02dad12..8aad59c600 100644 --- a/R/conversion.R +++ b/R/conversion.R @@ -366,10 +366,30 @@ as_adjacency_matrix <- function(graph, type = c("both", "upper", "lower"), } } +#' Convert a graph to an adjacency matrix +#' +#' `r lifecycle::badge("deprecated")` +#' We plan to remove `as_adj()` in favor of the more explicitly named +#' `as_adjacency_matrix()` so please use `as_adjacency_matrix()` instead. +#' #' @export -#' @rdname as_adjacency_matrix -as_adj <- as_adjacency_matrix - +#' @inheritParams as_adjacency_matrix +#' @keywords internal +as_adj <- function(graph, type = c("both", "upper", "lower"), + attr = NULL, edges = deprecated(), names = TRUE, + sparse = igraph_opt("sparsematrices")) { + + lifecycle::deprecate_soft("2.0.4", "as_adj()", "as_adjacency_matrix()") + + as_adjacency_matrix( + graph = graph, + type = type, + attr = attr, + edges = edges, + names = names, + sparse = sparse + ) +} #' Convert a graph to an edge list #' #' Sometimes it is useful to work with a standard representation of a @@ -549,7 +569,7 @@ as_undirected <- function(graph, mode = c("collapse", "each", "mutual"), edge.at #' vectors of the adjacency lists are coerced to `igraph.vs`, this can be #' a very expensive operation on large graphs. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} -#' @seealso [as_edgelist()], [as_adj()] +#' @seealso [as_edgelist()], [as_adjacency_matrix()] #' @family conversion #' @export #' @keywords graphs @@ -652,7 +672,7 @@ as_adj_edge_list <- function(graph, #' whenever possible, before adding them to the igraph graph. #' @return `graph_from_graphnel()` returns an igraph graph object. #' @seealso [as_graphnel()] for the other direction, -#' [as_adj()], [graph_from_adjacency_matrix()], +#' [as_adjacency_matrix()], [graph_from_adjacency_matrix()], #' [as_adj_list()] and [graph_from_adj_list()] for other #' graph representations. #' @examplesIf rlang::is_installed("graph") @@ -741,7 +761,7 @@ graph_from_graphnel <- function(graphNEL, name = TRUE, weight = TRUE, #' @param graph An igraph graph object. #' @return `as_graphnel()` returns a graphNEL graph object. #' @seealso [graph_from_graphnel()] for the other direction, -#' [as_adj()], [graph_from_adjacency_matrix()], +#' [as_adjacency_matrix()], [graph_from_adjacency_matrix()], #' [as_adj_list()] and [graph_from_adj_list()] for #' other graph representations. #' diff --git a/R/indexing.R b/R/indexing.R index aa2db39f4e..83716da5ce 100644 --- a/R/indexing.R +++ b/R/indexing.R @@ -196,27 +196,27 @@ res } else if (missing(i) && missing(j)) { if (missing(edges)) { - as_adj(x, sparse = sparse, attr = attr) + as_adjacency_matrix(x, sparse = sparse, attr = attr) } else { - as_adj(x, sparse = sparse, attr = attr, edges = edges) + as_adjacency_matrix(x, sparse = sparse, attr = attr, edges = edges) } } else if (missing(j)) { if (missing(edges)) { - as_adj(x, sparse = sparse, attr = attr)[i, , drop = drop] + as_adjacency_matrix(x, sparse = sparse, attr = attr)[i, , drop = drop] } else { - as_adj(x, sparse = sparse, attr = attr, edges = edges)[i, , drop = drop] + as_adjacency_matrix(x, sparse = sparse, attr = attr, edges = edges)[i, , drop = drop] } } else if (missing(i)) { if (missing(edges)) { - as_adj(x, sparse = sparse, attr = attr)[, j, drop = drop] + as_adjacency_matrix(x, sparse = sparse, attr = attr)[, j, drop = drop] } else { - as_adj(x, sparse = sparse, attr = attr, edges = edges)[, j, drop = drop] + as_adjacency_matrix(x, sparse = sparse, attr = attr, edges = edges)[, j, drop = drop] } } else { if (missing(edges)) { - as_adj(x, sparse = sparse, attr = attr)[i, j, drop = drop] + as_adjacency_matrix(x, sparse = sparse, attr = attr)[i, j, drop = drop] } else { - as_adj(x, sparse = sparse, attr = attr, edges = edges)[i, j, drop = drop] + as_adjacency_matrix(x, sparse = sparse, attr = attr, edges = edges)[i, j, drop = drop] } } } diff --git a/R/stochastic_matrix.R b/R/stochastic_matrix.R index f605a249ce..8859e11d7a 100644 --- a/R/stochastic_matrix.R +++ b/R/stochastic_matrix.R @@ -54,7 +54,7 @@ get.stochastic <- function(graph, column.wise = FALSE, sparse = igraph_opt("spar #' @return A regular matrix or a matrix of class `Matrix` if a #' `sparse` argument was `TRUE`. #' @author Gabor Csardi \email{csardi.gabor@@gmail.com} -#' @seealso [as_adj()] +#' @seealso [as_adjacency_matrix()] #' @export #' @keywords graphs #' @examples diff --git a/demo/community.R b/demo/community.R index e75059ee19..6ef423db61 100644 --- a/demo/community.R +++ b/demo/community.R @@ -72,7 +72,7 @@ if (require(Matrix)) { } else { myimage <- image } -A <- as_adj(G) +A <- as_adjacency_matrix(G) myimage(A) pause() diff --git a/man/arpack.Rd b/man/arpack.Rd index 604a431331..61144d785e 100644 --- a/man/arpack.Rd +++ b/man/arpack.Rd @@ -184,7 +184,7 @@ eigen(laplacian_matrix(make_star(10, mode = "undirected"))) if (require(Matrix)) { set.seed(42) g <- sample_gnp(1000, 5 / 1000) - M <- as_adj(g, sparse = TRUE) + M <- as_adjacency_matrix(g, sparse = TRUE) f2 <- function(x, extra = NULL) { cat(".") as.vector(M \%*\% x) diff --git a/man/as_adj.Rd b/man/as_adj.Rd new file mode 100644 index 0000000000..9de8dba098 --- /dev/null +++ b/man/as_adj.Rd @@ -0,0 +1,54 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/conversion.R +\name{as_adj} +\alias{as_adj} +\title{Convert a graph to an adjacency matrix} +\usage{ +as_adj( + graph, + type = c("both", "upper", "lower"), + attr = NULL, + edges = deprecated(), + names = TRUE, + sparse = igraph_opt("sparsematrices") +) +} +\arguments{ +\item{graph}{The graph to convert.} + +\item{type}{Gives how to create the adjacency matrix for undirected graphs. +It is ignored for directed graphs. Possible values: \code{upper}: the upper +right triangle of the matrix is used, \code{lower}: the lower left triangle +of the matrix is used. \code{both}: the whole matrix is used, a symmetric +matrix is returned.} + +\item{attr}{Either \code{NULL} or a character string giving an edge +attribute name. If \code{NULL} a traditional adjacency matrix is returned. +If not \code{NULL} then the values of the given edge attribute are included +in the adjacency matrix. If the graph has multiple edges, the edge attribute +of an arbitrarily chosen edge (for the multiple edges) is included. This +argument is ignored if \code{edges} is \code{TRUE}. + +Note that this works only for certain attribute types. If the \code{sparse} +argumen is \code{TRUE}, then the attribute must be either logical or +numeric. If the \code{sparse} argument is \code{FALSE}, then character is +also allowed. The reason for the difference is that the \code{Matrix} +package does not support character sparse matrices yet.} + +\item{edges}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Logical scalar, whether to return the edge ids in the matrix. +For non-existant edges zero is returned.} + +\item{names}{Logical constant, whether to assign row and column names +to the matrix. These are only assigned if the \code{name} vertex attribute +is present in the graph.} + +\item{sparse}{Logical scalar, whether to create a sparse matrix. The +\sQuote{\code{Matrix}} package must be installed for creating sparse +matrices.} +} +\description{ +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} +We plan to remove \code{as_adj()} in favor of the more explicitly named +\code{as_adjacency_matrix()} so please use \code{as_adjacency_matrix()} instead. +} +\keyword{internal} diff --git a/man/as_adj_list.Rd b/man/as_adj_list.Rd index b240ce1799..24d1762373 100644 --- a/man/as_adj_list.Rd +++ b/man/as_adj_list.Rd @@ -63,7 +63,7 @@ as_adj_edge_list(g) } \seealso{ -\code{\link[=as_edgelist]{as_edgelist()}}, \code{\link[=as_adj]{as_adj()}} +\code{\link[=as_edgelist]{as_edgelist()}}, \code{\link[=as_adjacency_matrix]{as_adjacency_matrix()}} Other conversion: \code{\link{as.matrix.igraph}()}, diff --git a/man/as_adjacency_matrix.Rd b/man/as_adjacency_matrix.Rd index db5a0c2343..5f6215049b 100644 --- a/man/as_adjacency_matrix.Rd +++ b/man/as_adjacency_matrix.Rd @@ -2,7 +2,6 @@ % Please edit documentation in R/conversion.R \name{as_adjacency_matrix} \alias{as_adjacency_matrix} -\alias{as_adj} \title{Convert a graph to an adjacency matrix} \usage{ as_adjacency_matrix( @@ -13,15 +12,6 @@ as_adjacency_matrix( names = TRUE, sparse = igraph_opt("sparsematrices") ) - -as_adj( - graph, - type = c("both", "upper", "lower"), - attr = NULL, - edges = deprecated(), - names = TRUE, - sparse = igraph_opt("sparsematrices") -) } \arguments{ \item{graph}{The graph to convert.} diff --git a/man/as_graphnel.Rd b/man/as_graphnel.Rd index b4c33bac98..6575a54cbe 100644 --- a/man/as_graphnel.Rd +++ b/man/as_graphnel.Rd @@ -43,7 +43,7 @@ g4 } \seealso{ \code{\link[=graph_from_graphnel]{graph_from_graphnel()}} for the other direction, -\code{\link[=as_adj]{as_adj()}}, \code{\link[=graph_from_adjacency_matrix]{graph_from_adjacency_matrix()}}, +\code{\link[=as_adjacency_matrix]{as_adjacency_matrix()}}, \code{\link[=graph_from_adjacency_matrix]{graph_from_adjacency_matrix()}}, \code{\link[=as_adj_list]{as_adj_list()}} and \code{\link[=graph_from_adj_list]{graph_from_adj_list()}} for other graph representations. diff --git a/man/graph_from_graphnel.Rd b/man/graph_from_graphnel.Rd index 29469e22c3..d812659128 100644 --- a/man/graph_from_graphnel.Rd +++ b/man/graph_from_graphnel.Rd @@ -57,7 +57,7 @@ g4 } \seealso{ \code{\link[=as_graphnel]{as_graphnel()}} for the other direction, -\code{\link[=as_adj]{as_adj()}}, \code{\link[=graph_from_adjacency_matrix]{graph_from_adjacency_matrix()}}, +\code{\link[=as_adjacency_matrix]{as_adjacency_matrix()}}, \code{\link[=graph_from_adjacency_matrix]{graph_from_adjacency_matrix()}}, \code{\link[=as_adj_list]{as_adj_list()}} and \code{\link[=graph_from_adj_list]{graph_from_adj_list()}} for other graph representations. diff --git a/man/spectrum.Rd b/man/spectrum.Rd index de80c18a52..06f42ce2f6 100644 --- a/man/spectrum.Rd +++ b/man/spectrum.Rd @@ -65,7 +65,7 @@ kite <- make_graph("Krackhardt_kite") spectrum(kite)[c("values", "vectors")] ## Double check -eigen(as_adj(kite, sparse = FALSE))$vectors[, 1] +eigen(as_adjacency_matrix(kite, sparse = FALSE))$vectors[, 1] ## Should be the same as 'eigen_centrality' (but rescaled) cor(eigen_centrality(kite)$vector, spectrum(kite)$vectors) @@ -75,7 +75,7 @@ spectrum(kite, which = list(pos = "SM", howmany = 2))$values } \seealso{ -\code{\link[=as_adj]{as_adj()}} to create a (sparse) adjacency matrix. +\code{\link[=as_adjacency_matrix]{as_adjacency_matrix()}} to create a (sparse) adjacency matrix. Centrality measures \code{\link{alpha_centrality}()}, diff --git a/man/stochastic_matrix.Rd b/man/stochastic_matrix.Rd index e2e177f5e0..b61b5fd87c 100644 --- a/man/stochastic_matrix.Rd +++ b/man/stochastic_matrix.Rd @@ -50,7 +50,7 @@ max(abs(rowSums(W)) - 1) } \seealso{ -\code{\link[=as_adj]{as_adj()}} +\code{\link[=as_adjacency_matrix]{as_adjacency_matrix()}} } \author{ Gabor Csardi \email{csardi.gabor@gmail.com} diff --git a/tests/testthat/test-authority.score.R b/tests/testthat/test-authority.score.R index 63c33ef5a9..25d8eb4016 100644 --- a/tests/testthat/test-authority.score.R +++ b/tests/testthat/test-authority.score.R @@ -14,7 +14,7 @@ test_that("`authority_score()` works", { c(1, 3, 1, 6, 1, 10, 2, 1, 3, 1, 4, 2, 4, 7, 4, 9, 5, 4, 5, 6, 5, 8, 6, 3, 7, 1, 7, 5, 7, 6, 7, 10, 8, 4, 9, 6, 10, 5, 10, 7), directed = TRUE) - A <- as_adj(g1, sparse = FALSE) + A <- as_adjacency_matrix(g1, sparse = FALSE) s1 <- eigen(t(A) %*% A)$vectors[, 1] s2 <- authority_score(g1)$vector expect_equal( @@ -29,7 +29,7 @@ test_that("`authority_score()` works", { c(1, 2, 1, 4, 2, 3, 2, 4, 3, 1, 3, 5, 4, 3, 5, 1, 5, 2), directed = TRUE ) - A <- as_adj(g2, sparse = FALSE) + A <- as_adjacency_matrix(g2, sparse = FALSE) s1 <- eigen(t(A) %*% A)$vectors[, 1] s2 <- authority_score(g2)$vector expect_equal( @@ -63,7 +63,7 @@ test_that("`hub_score()` works", { c(1, 3, 1, 6, 1, 10, 2, 1, 3, 1, 4, 2, 4, 7, 4, 9, 5, 4, 5, 6, 5, 8, 6, 3, 7, 1, 7, 5, 7, 6, 7, 10, 8, 4, 9, 6, 10, 5, 10, 7), directed = TRUE) - A <- as_adj(g1, sparse = FALSE) + A <- as_adjacency_matrix(g1, sparse = FALSE) s1 <- eigen(A %*% t(A))$vectors[, 1] s2 <- hub_score(g1)$vector expect_equal( @@ -78,7 +78,7 @@ test_that("`hub_score()` works", { c(1, 2, 1, 4, 2, 3, 2, 4, 3, 1, 3, 5, 4, 3, 5, 1, 5, 2), directed = TRUE ) - A <- as_adj(g2, sparse = FALSE) + A <- as_adjacency_matrix(g2, sparse = FALSE) s1 <- eigen(A %*% t(A))$vectors[, 1] s2 <- hub_score(g2)$vector expect_equal( @@ -117,14 +117,14 @@ test_that("authority_score survives stress test", { for (i in 1:100) { G <- sample_gnm(10, sample(1:20, 1)) as <- hits_scores(G) - M <- as_adj(G, sparse = FALSE) + M <- as_adjacency_matrix(G, sparse = FALSE) is.good(t(M) %*% M, as$authority, as$value) } for (i in 1:100) { G <- sample_gnm(10, sample(1:20, 1)) hs <- hits_scores(G) - M <- as_adj(G, sparse = FALSE) + M <- as_adjacency_matrix(G, sparse = FALSE) is.good(M %*% t(M), hs$hub, hs$value) } }) @@ -144,7 +144,7 @@ test_that("`hits_score()` works -- authority", { c(1, 3, 1, 6, 1, 10, 2, 1, 3, 1, 4, 2, 4, 7, 4, 9, 5, 4, 5, 6, 5, 8, 6, 3, 7, 1, 7, 5, 7, 6, 7, 10, 8, 4, 9, 6, 10, 5, 10, 7), directed = TRUE) - A <- as_adj(g1, sparse = FALSE) + A <- as_adjacency_matrix(g1, sparse = FALSE) s1 <- eigen(t(A) %*% A)$vectors[, 1] s2 <- hits_scores(g1)$authority expect_equal( @@ -159,7 +159,7 @@ test_that("`hits_score()` works -- authority", { c(1, 2, 1, 4, 2, 3, 2, 4, 3, 1, 3, 5, 4, 3, 5, 1, 5, 2), directed = TRUE ) - A <- as_adj(g2, sparse = FALSE) + A <- as_adjacency_matrix(g2, sparse = FALSE) s1 <- eigen(t(A) %*% A)$vectors[, 1] s2 <- hits_scores(g2)$authority expect_equal( @@ -186,7 +186,7 @@ test_that("`hits_scores()` works -- hub", { c(1, 3, 1, 6, 1, 10, 2, 1, 3, 1, 4, 2, 4, 7, 4, 9, 5, 4, 5, 6, 5, 8, 6, 3, 7, 1, 7, 5, 7, 6, 7, 10, 8, 4, 9, 6, 10, 5, 10, 7), directed = TRUE) - A <- as_adj(g1, sparse = FALSE) + A <- as_adjacency_matrix(g1, sparse = FALSE) s1 <- eigen(A %*% t(A))$vectors[, 1] s2 <- hits_scores(g1)$hub expect_equal( @@ -201,7 +201,7 @@ test_that("`hits_scores()` works -- hub", { c(1, 2, 1, 4, 2, 3, 2, 4, 3, 1, 3, 5, 4, 3, 5, 1, 5, 2), directed = TRUE ) - A <- as_adj(g2, sparse = FALSE) + A <- as_adjacency_matrix(g2, sparse = FALSE) s1 <- eigen(A %*% t(A))$vectors[, 1] s2 <- hits_scores(g2)$hub expect_equal( diff --git a/tests/testthat/test-centrality.R b/tests/testthat/test-centrality.R index efc0b74622..8a6352c14d 100644 --- a/tests/testthat/test-centrality.R +++ b/tests/testthat/test-centrality.R @@ -2,14 +2,14 @@ test_that("subgraph_centrality() works", { frucht_graph <- make_graph("Frucht") expect_equal( subgraph_centrality(frucht_graph), - Matrix::diag(Matrix::expm(as_adj(frucht_graph, sparse = FALSE))), + Matrix::diag(Matrix::expm(as_adjacency_matrix(frucht_graph, sparse = FALSE))), tolerance = 1e-10 ) grotzsch_graph <- make_graph("Grotzsch") expect_equal( subgraph_centrality(grotzsch_graph), - Matrix::diag(Matrix::expm(as_adj(grotzsch_graph, sparse = FALSE))), + Matrix::diag(Matrix::expm(as_adjacency_matrix(grotzsch_graph, sparse = FALSE))), tolerance = 1e-10 ) }) diff --git a/tests/testthat/test-evcent.R b/tests/testthat/test-evcent.R index 8e009c31b8..f4d79444f0 100644 --- a/tests/testthat/test-evcent.R +++ b/tests/testthat/test-evcent.R @@ -32,6 +32,6 @@ test_that("eigen_centrality works", { for (i in 1:1000) { G <- sample_gnm(10, sample(1:20, 1)) ev <- eigen_centrality(G) - expect_true(is.good(as_adj(G, sparse = FALSE), ev$vector, ev$value)) + expect_true(is.good(as_adjacency_matrix(G, sparse = FALSE), ev$vector, ev$value)) } }) diff --git a/tests/testthat/test-get.adjacency.R b/tests/testthat/test-get.adjacency.R index 95ee36b41b..34cf447800 100644 --- a/tests/testthat/test-get.adjacency.R +++ b/tests/testthat/test-get.adjacency.R @@ -1,25 +1,25 @@ test_that("as_adj works", { g <- sample_gnp(50, 1 / 50) - A <- as_adj(g, sparse = FALSE) + A <- as_adjacency_matrix(g, sparse = FALSE) g2 <- graph_from_adjacency_matrix(A, mode = "undirected") expect_isomorphic(g, g2) ### - A <- as_adj(g, sparse = TRUE) + A <- as_adjacency_matrix(g, sparse = TRUE) g2 <- graph_from_adjacency_matrix(A, mode = "undirected") expect_isomorphic(g, g2) ### g <- sample_gnp(50, 2 / 50, directed = TRUE) - A <- as_adj(g, sparse = FALSE) + A <- as_adjacency_matrix(g, sparse = FALSE) g2 <- graph_from_adjacency_matrix(A) expect_isomorphic(g, g2) ### - A <- as_adj(g, sparse = TRUE) + A <- as_adjacency_matrix(g, sparse = TRUE) g2 <- graph_from_adjacency_matrix(A) expect_isomorphic(g, g2) }) diff --git a/tests/testthat/test-graph.eigen.R b/tests/testthat/test-graph.eigen.R index 4a58aa5f53..5bac0a6ced 100644 --- a/tests/testthat/test-graph.eigen.R +++ b/tests/testthat/test-graph.eigen.R @@ -13,7 +13,7 @@ test_that("spectrum works for symmetric matrices", { } g <- sample_gnp(50, 5 / 50) - e0 <- eigen(as_adj(g, sparse = FALSE)) + e0 <- eigen(as_adjacency_matrix(g, sparse = FALSE)) e1 <- spectrum(g, which = list(howmany = 4, pos = "LA")) expect_equal(e0$values[1:4], e1$values) diff --git a/tests/testthat/test-graphNEL.R b/tests/testthat/test-graphNEL.R index a0071497d3..07374b9340 100644 --- a/tests/testthat/test-graphNEL.R +++ b/tests/testthat/test-graphNEL.R @@ -22,8 +22,8 @@ test_that("graphNEL conversion works", { expect_isomorphic(g, g2) expect_equal(V(g)$name, V(g2)$name) - A <- as_adj(g, attr = "weight", sparse = FALSE) - A2 <- as_adj(g2, attr = "weight", sparse = FALSE) + A <- as_adjacency_matrix(g, attr = "weight", sparse = FALSE) + A2 <- as_adjacency_matrix(g2, attr = "weight", sparse = FALSE) expect_equal(A, A) expect_equal(g$name, g2$name) }) diff --git a/tests/testthat/test-leading.eigenvector.community.R b/tests/testthat/test-leading.eigenvector.community.R index 8ae47e4b22..9aadd9be08 100644 --- a/tests/testthat/test-leading.eigenvector.community.R +++ b/tests/testthat/test-leading.eigenvector.community.R @@ -50,7 +50,7 @@ test_that("cluster_leading_eigen works", { } g <- make_graph("Zachary") - A <- as_adj(g, sparse = FALSE) + A <- as_adjacency_matrix(g, sparse = FALSE) ec <- ecount(g) deg <- degree(g) lc <- cluster_leading_eigen(g, callback = f) diff --git a/tests/testthat/test-structural.properties.R b/tests/testthat/test-structural.properties.R index 96cc76b155..94703a2691 100644 --- a/tests/testthat/test-structural.properties.R +++ b/tests/testthat/test-structural.properties.R @@ -514,7 +514,7 @@ test_that("constraint() works", { constraint.orig <- function(graph, nodes = V(graph), attr = NULL) { ensure_igraph(graph) idx <- degree(graph) != 0 - A <- as_adj(graph, attr = attr, sparse = FALSE) + A <- as_adjacency_matrix(graph, attr = attr, sparse = FALSE) A <- A[idx, idx] n <- sum(idx)