1 2## ---------------------------------------------------------------- 3## 4## IGraph R package 5## Copyright (C) 2005-2014 Gabor Csardi <csardi.gabor@gmail.com> 6## 334 Harvard street, Cambridge, MA 02139 USA 7## 8## This program is free software; you can redistribute it and/or modify 9## it under the terms of the GNU General Public License as published by 10## the Free Software Foundation; either version 2 of the License, or 11## (at your option) any later version. 12## 13## This program is distributed in the hope that it will be useful, 14## but WITHOUT ANY WARRANTY; without even the implied warranty of 15## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16## GNU General Public License for more details. 17## 18## You should have received a copy of the GNU General Public License 19## along with this program; if not, write to the Free Software 20## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 21## 02110-1301 USA 22## 23## ----------------------------------------------------------------- 24 25graph.adjacency.dense <- function(adjmatrix, mode=c("directed", "undirected", "max", 26 "min", "upper", "lower", "plus"), 27 weighted=NULL, diag=TRUE) { 28 29 mode <- igraph.match.arg(mode) 30 mode <- switch(mode, 31 "directed"=0, 32 "undirected"=1, 33 "max"=1, 34 "upper"=2, 35 "lower"=3, 36 "min"=4, 37 "plus"=5) 38 39 mode(adjmatrix) <- "double" 40 41 if (!is.null(weighted)) { 42 if (is.logical(weighted) && weighted) { 43 weighted <- "weight" 44 } 45 if (!is.character(weighted)) { 46 stop("invalid value supplied for `weighted' argument, please see docs.") 47 } 48 49 if (nrow(adjmatrix) != ncol(adjmatrix)) { 50 stop("not a square matrix") 51 } 52 53 on.exit( .Call(C_R_igraph_finalizer) ) 54 res <- .Call(C_R_igraph_weighted_adjacency, adjmatrix, 55 as.numeric(mode), weighted, diag) 56 } else { 57 58 adjmatrix <- as.matrix(adjmatrix) 59 attrs <- attributes(adjmatrix) 60 adjmatrix <- as.numeric(adjmatrix) 61 attributes(adjmatrix) <- attrs 62 63 if (!diag) { diag(adjmatrix) <- 0 } 64 65 on.exit( .Call(C_R_igraph_finalizer) ) 66 res <- .Call(C_R_igraph_graph_adjacency, adjmatrix, as.numeric(mode)) 67 } 68 69 res 70} 71 72m2triplet <- get0("mat2triplet", asNamespace("Matrix"), inherits=FALSE) 73if(!is.function(m2triplet)) ## <==> (packageVersion("Matrix") < "1.3") 74 m2triplet <- function(x) { ## a simplified version of new Matrix' mat2triplet() 75 T <- as(x, "TsparseMatrix") 76 if(is(T, "nsparseMatrix")) 77 list(i = T@i + 1L, j = T@j + 1L) 78 else list(i = T@i + 1L, j = T@j + 1L, x = T@x) 79 } 80 81mysummary <- function(x) do.call(cbind, m2triplet(x)) 82 83graph.adjacency.sparse <- function(adjmatrix, mode=c("directed", "undirected", "max", 84 "min", "upper", "lower", "plus"), 85 weighted=NULL, diag=TRUE) { 86 87 mode <- igraph.match.arg(mode) 88 89 if (!is.null(weighted)) { 90 if (is.logical(weighted) && weighted) { 91 weighted <- "weight" 92 } 93 if (!is.character(weighted)) { 94 stop("invalid value supplied for `weighted' argument, please see docs.") 95 } 96 } 97 98 mysummary <- Matrix::summary 99 100 if (nrow(adjmatrix) != ncol(adjmatrix)) { 101 stop("not a square matrix") 102 } 103 104 vc <- nrow(adjmatrix) 105 106 ## to remove non-redundancies that can persist in a dgtMatrix 107 if(inherits(adjmatrix, "dgTMatrix")) { 108 adjmatrix = as(adjmatrix, "CsparseMatrix") 109 } else if (inherits(adjmatrix, "ddiMatrix")) { 110 adjmatrix = as(adjmatrix, "CsparseMatrix") 111 } 112 113 if (is.null(weighted) && mode=="undirected") { mode <- "max" } 114 115 if (mode == "directed") { 116 ## DIRECTED 117 el <- mysummary(adjmatrix) 118 if (!diag) { el <- el[ el[,1] != el[,2], ] } 119 } else if (mode == "undirected") { 120 ## UNDIRECTED, must be symmetric if weighted 121 if (!is.null(weighted) && !Matrix::isSymmetric(adjmatrix)) { 122 stop("Please supply a symmetric matrix if you want to create a weighted graph with mode=UNDIRECTED.") 123 } 124 if (diag) { 125 adjmatrix <- Matrix::tril(adjmatrix) 126 } else { 127 adjmatrix <- Matrix::tril(adjmatrix, -1) 128 } 129 el <- mysummary(adjmatrix) 130 } else if (mode=="max") { 131 ## MAXIMUM 132 el <- mysummary(adjmatrix) 133 rm(adjmatrix) 134 if (!diag) { el <- el[ el[,1] != el[,2], ] } 135 el <- el[ el[,3] != 0, ] 136 w <- el[,3] 137 el <- el[,1:2] 138 el <- cbind( pmin(el[,1],el[,2]), pmax(el[,1], el[,2]) ) 139 o <- order(el[,1], el[,2]) 140 el <- el[o,,drop=FALSE] 141 w <- w[o] 142 if (nrow(el) > 1) { 143 dd <- el[2:nrow(el),1] == el[1:(nrow(el)-1),1] & 144 el[2:nrow(el),2] == el[1:(nrow(el)-1),2] 145 dd <- which(dd) 146 if (length(dd)>0) { 147 mw <- pmax(w[dd], w[dd+1]) 148 w[dd] <- mw 149 w[dd+1] <- mw 150 el <- el[-dd,,drop=FALSE] 151 w <- w[-dd] 152 } 153 } 154 el <- cbind(el, w) 155 } else if (mode=="upper") { 156 ## UPPER 157 if (diag) { 158 adjmatrix <- Matrix::triu(adjmatrix) 159 } else { 160 adjmatrix <- Matrix::triu(adjmatrix, 1) 161 } 162 el <- mysummary(adjmatrix) 163 rm(adjmatrix) 164 if (!diag) { el <- el[ el[,1] != el[,2], ] } 165 } else if (mode=="lower") { 166 ## LOWER 167 if (diag) { 168 adjmatrix <- Matrix::tril(adjmatrix) 169 } else { 170 adjmatrix <- Matrix::tril(adjmatrix, -1) 171 } 172 el <- mysummary(adjmatrix) 173 rm(adjmatrix) 174 if (!diag) { el <- el[ el[,1] != el[,2], ] } 175 } else if (mode=="min") { 176 ## MINIMUM 177 adjmatrix <- sign(adjmatrix) * sign(Matrix::t(adjmatrix)) * adjmatrix 178 el <- mysummary(adjmatrix) 179 if (!diag) { el <- el[ el[,1] != el[,2], ] } 180 el <- el[ el[,3] != 0, ] 181 w <- el[,3] 182 el <- el[,1:2] 183 el <- cbind( pmin(el[,1],el[,2]), pmax(el[,1], el[,2]) ) 184 o <- order(el[,1], el[,2]) 185 el <- el[o,] 186 w <- w[o] 187 if (nrow(el) > 1) { 188 dd <- el[2:nrow(el),1] == el[1:(nrow(el)-1),1] & 189 el[2:nrow(el),2] == el[1:(nrow(el)-1),2] 190 dd <- which(dd) 191 if (length(dd)>0) { 192 mw <- pmin(w[dd], w[dd+1]) 193 w[dd] <- mw 194 w[dd+1] <- mw 195 el <- el[-dd,] 196 w <- w[-dd] 197 } 198 } 199 el <- cbind(el, w) 200 } else if (mode=="plus") { 201 ## PLUS 202 adjmatrix <- adjmatrix + Matrix::t(adjmatrix) 203 if (diag) { 204 adjmatrix <- Matrix::tril(adjmatrix) 205 } else { 206 adjmatrix <- Matrix::tril(adjmatrix, -1) 207 } 208 el <- mysummary(adjmatrix) 209 if (diag) { 210 loop <- el[,1] == el[,2] 211 el[loop,3] <- el[loop,3] / 2 212 } 213 el <- el[ el[,3] != 0, ] 214 rm(adjmatrix) 215 } 216 217 if (!is.null(weighted)) { 218 res <- make_empty_graph(n=vc, directed=(mode=="directed")) 219 weight <- list(el[,3]) 220 names(weight) <- weighted 221 res <- add_edges(res, edges=t(as.matrix(el[,1:2])), attr=weight) 222 } else { 223 edges <- unlist(apply(el, 1, function(x) rep(unname(x[1:2]), x[3]))) 224 res <- graph(n=vc, edges, directed=(mode=="directed")) 225 } 226 res 227} 228 229 230 231#' Create graphs from adjacency matrices 232#' 233#' \code{graph_from_adjacency_matrix} is a flexible function for creating \code{igraph} 234#' graphs from adjacency matrices. 235#' 236#' The order of the vertices are preserved, i.e. the vertex corresponding to 237#' the first row will be vertex 0 in the graph, etc. 238#' 239#' \code{graph_from_adjacency_matrix} operates in two main modes, depending on the 240#' \code{weighted} argument. 241#' 242#' If this argument is \code{NULL} then an unweighted graph is created and an 243#' element of the adjacency matrix gives the number of edges to create between 244#' the two corresponding vertices. The details depend on the value of the 245#' \code{mode} argument: \describe{ \item{"directed"}{The graph will be 246#' directed and a matrix element gives the number of edges between two 247#' vertices.} \item{"undirected"}{This is exactly the same as \code{max}, 248#' for convenience. Note that it is \emph{not} checked whether the matrix is 249#' symmetric.} \item{"max"}{An undirected graph will be created and 250#' \code{max(A(i,j), A(j,i))} gives the number of edges.} 251#' \item{"upper"}{An undirected graph will be created, only the upper 252#' right triangle (including the diagonal) is used for the number of edges.} 253#' \item{"lower"}{An undirected graph will be created, only the lower 254#' left triangle (including the diagonal) is used for creating the edges.} 255#' \item{"min"}{undirected graph will be created with \code{min(A(i,j), 256#' A(j,i))} edges between vertex \code{i} and \code{j}.} \item{"plus"}{ 257#' undirected graph will be created with \code{A(i,j)+A(j,i)} edges between 258#' vertex \code{i} and \code{j}.} } 259#' 260#' If the \code{weighted} argument is not \code{NULL} then the elements of the 261#' matrix give the weights of the edges (if they are not zero). The details 262#' depend on the value of the \code{mode} argument: \describe{ 263#' \item{"directed"}{The graph will be directed and a matrix element 264#' gives the edge weights.} \item{"undirected"}{First we check that the 265#' matrix is symmetric. It is an error if not. Then only the upper triangle is 266#' used to create a weighted undirected graph.} \item{"max"}{An 267#' undirected graph will be created and \code{max(A(i,j), A(j,i))} gives the 268#' edge weights.} \item{"upper"}{An undirected graph will be created, 269#' only the upper right triangle (including the diagonal) is used (for the edge 270#' weights).} \item{"lower"}{An undirected graph will be created, only 271#' the lower left triangle (including the diagonal) is used for creating the 272#' edges.} \item{"min"}{An undirected graph will be created, 273#' \code{min(A(i,j), A(j,i))} gives the edge weights.} \item{"plus"}{An 274#' undirected graph will be created, \code{A(i,j)+A(j,i)} gives the edge 275#' weights.} } 276#' 277#' @aliases graph.adjacency 278#' @param adjmatrix A square adjacency matrix. From igraph version 0.5.1 this 279#' can be a sparse matrix created with the \code{Matrix} package. 280#' @param mode Character scalar, specifies how igraph should interpret the 281#' supplied matrix. See also the \code{weighted} argument, the interpretation 282#' depends on that too. Possible values are: \code{directed}, 283#' \code{undirected}, \code{upper}, \code{lower}, \code{max}, \code{min}, 284#' \code{plus}. See details below. 285#' @param weighted This argument specifies whether to create a weighted graph 286#' from an adjacency matrix. If it is \code{NULL} then an unweighted graph is 287#' created and the elements of the adjacency matrix gives the number of edges 288#' between the vertices. If it is a character constant then for every non-zero 289#' matrix entry an edge is created and the value of the entry is added as an 290#' edge attribute named by the \code{weighted} argument. If it is \code{TRUE} 291#' then a weighted graph is created and the name of the edge attribute will be 292#' \code{weight}. See also details below. 293#' @param diag Logical scalar, whether to include the diagonal of the matrix in 294#' the calculation. If this is \code{FALSE} then the diagonal is zerod out 295#' first. 296#' @param add.colnames Character scalar, whether to add the column names as 297#' vertex attributes. If it is \sQuote{\code{NULL}} (the default) then, if 298#' present, column names are added as vertex attribute \sQuote{name}. If 299#' \sQuote{\code{NA}} then they will not be added. If a character constant, 300#' then it gives the name of the vertex attribute to add. 301#' @param add.rownames Character scalar, whether to add the row names as vertex 302#' attributes. Possible values the same as the previous argument. By default 303#' row names are not added. If \sQuote{\code{add.rownames}} and 304#' \sQuote{\code{add.colnames}} specify the same vertex attribute, then the 305#' former is ignored. 306#' @return An igraph graph object. 307#' @author Gabor Csardi \email{csardi.gabor@@gmail.com} 308#' @seealso \link{graph} and \code{\link{graph_from_literal}} for other ways to 309#' create graphs. 310#' @keywords graphs 311#' @examples 312#' 313#' adjm <- matrix(sample(0:1, 100, replace=TRUE, prob=c(0.9,0.1)), nc=10) 314#' g1 <- graph_from_adjacency_matrix( adjm ) 315#' adjm <- matrix(sample(0:5, 100, replace=TRUE, 316#' prob=c(0.9,0.02,0.02,0.02,0.02,0.02)), nc=10) 317#' g2 <- graph_from_adjacency_matrix(adjm, weighted=TRUE) 318#' E(g2)$weight 319#' 320#' ## various modes for weighted graphs, with some tests 321#' nzs <- function(x) sort(x [x!=0]) 322#' adjm <- matrix(runif(100), 10) 323#' adjm[ adjm<0.5 ] <- 0 324#' g3 <- graph_from_adjacency_matrix((adjm + t(adjm))/2, weighted=TRUE, 325#' mode="undirected") 326#' 327#' g4 <- graph_from_adjacency_matrix(adjm, weighted=TRUE, mode="max") 328#' all(nzs(pmax(adjm, t(adjm))[upper.tri(adjm)]) == sort(E(g4)$weight)) 329#' 330#' g5 <- graph_from_adjacency_matrix(adjm, weighted=TRUE, mode="min") 331#' all(nzs(pmin(adjm, t(adjm))[upper.tri(adjm)]) == sort(E(g5)$weight)) 332#' 333#' g6 <- graph_from_adjacency_matrix(adjm, weighted=TRUE, mode="upper") 334#' all(nzs(adjm[upper.tri(adjm)]) == sort(E(g6)$weight)) 335#' 336#' g7 <- graph_from_adjacency_matrix(adjm, weighted=TRUE, mode="lower") 337#' all(nzs(adjm[lower.tri(adjm)]) == sort(E(g7)$weight)) 338#' 339#' g8 <- graph_from_adjacency_matrix(adjm, weighted=TRUE, mode="plus") 340#' d2 <- function(x) { diag(x) <- diag(x)/2; x } 341#' all(nzs((d2(adjm+t(adjm)))[lower.tri(adjm)]) == sort(E(g8)$weight)) 342#' 343#' g9 <- graph_from_adjacency_matrix(adjm, weighted=TRUE, mode="plus", diag=FALSE) 344#' d0 <- function(x) { diag(x) <- 0 } 345#' all(nzs((d0(adjm+t(adjm)))[lower.tri(adjm)]) == sort(E(g9)$weight)) 346#' 347#' ## row/column names 348#' rownames(adjm) <- sample(letters, nrow(adjm)) 349#' colnames(adjm) <- seq(ncol(adjm)) 350#' g10 <- graph_from_adjacency_matrix(adjm, weighted=TRUE, add.rownames="code") 351#' summary(g10) 352#' 353graph_from_adjacency_matrix <- function(adjmatrix, mode=c("directed", "undirected", "max", 354 "min", "upper", "lower", "plus"), 355 weighted=NULL, diag=TRUE, 356 add.colnames=NULL, add.rownames=NA) { 357 358 if (inherits(adjmatrix, "Matrix")) { 359 res <- graph.adjacency.sparse(adjmatrix, mode=mode, weighted=weighted, diag=diag) 360 } else { 361 res <- graph.adjacency.dense(adjmatrix, mode=mode, weighted=weighted, diag=diag) 362 } 363 364 ## Add columns and row names as attributes 365 if (is.null(add.colnames)) { 366 if (!is.null(colnames(adjmatrix))) { 367 add.colnames <- "name" 368 } else { 369 add.colnames <- NA 370 } 371 } else if (!is.na(add.colnames)) { 372 if (is.null(colnames(adjmatrix))) { 373 warning("No column names to add") 374 add.colnames <- NA 375 } 376 } 377 378 if (is.null(add.rownames)) { 379 if (!is.null(rownames(adjmatrix))) { 380 add.rownames <- "name" 381 } else { 382 add.colnames <- NA 383 } 384 } else if (!is.na(add.rownames)) { 385 if (is.null(rownames(adjmatrix))) { 386 warning("No row names to add") 387 add.rownames <- NA 388 } 389 } 390 391 if (!is.na(add.rownames) && !is.na(add.colnames) && 392 add.rownames == add.colnames ) { 393 warning("Same attribute for columns and rows, row names are ignored") 394 add.rownames <- NA 395 } 396 397 if (!is.na(add.colnames)) { 398 res <- set_vertex_attr(res, add.colnames, value=colnames(adjmatrix)) 399 } 400 if (!is.na(add.rownames)) { 401 res <- set_vertex_attr(res, add.rownames, value=rownames(adjmatrix)) 402 } 403 404 res 405} 406 407#' @rdname graph_from_adjacency_matrix 408#' @param ... Passed to \code{graph_from_adjacency_matrix}. 409#' @export 410 411from_adjacency <- function(...) constructor_spec(graph_from_adjacency_matrix, ...) 412