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.incidence.sparse <- function(incidence, directed, mode, multiple, 26 weighted) { 27 n1 <- nrow(incidence) 28 n2 <- ncol(incidence) 29 el <- mysummary(incidence) 30 el[,2] <- el[,2] + n1 31 32 if (!is.null(weighted)) { 33 34 if (is.logical(weighted) && weighted) { 35 weighted <- "weight" 36 } 37 if (!is.character(weighted)) { 38 stop("invalid value supplied for `weighted' argument, please see docs.") 39 } 40 41 if (!directed || mode==1) { 42 ## nothing do to 43 } else if (mode==2) { 44 el[,1:2] <- el[,c(2,1)] 45 } else if (mode==3) { 46 el <- rbind(el, el[,c(2,1,3)]) 47 } 48 49 res <- make_empty_graph(n=n1+n2, directed=directed) 50 weight <- list(el[,3]) 51 names(weight) <- weighted 52 res <- add_edges(res, edges=t(as.matrix(el[,1:2])), attr=weight) 53 54 } else { 55 56 if (multiple) { 57 el[,3] <- ceiling(el[,3]) 58 el[,3][ el[,3] < 0 ] <- 0 59 } else { 60 el[,3] <- el[,3] != 0 61 } 62 63 if (!directed || mode==1) { 64 ## nothing do to 65 } else if (mode==2) { 66 el[,1:2] <- el[,c(2,1)] 67 } else if (mode==3) { 68 el <- rbind(el, el[,c(2,1,3)]) 69 } 70 71 edges <- unlist(apply(el, 1, function(x) rep(unname(x[1:2]), x[3]))) 72 res <- graph(n=n1+n2, edges, directed=directed) 73 } 74 75 set_vertex_attr(res, "type", value=c(rep(FALSE, n1), rep(TRUE, n2))) 76} 77 78graph.incidence.dense <- function(incidence, directed, mode, multiple, 79 weighted) { 80 81 if (!is.null(weighted)) { 82 if (is.logical(weighted) && weighted) { 83 weighted <- "weight" 84 } 85 if (!is.character(weighted)) { 86 stop("invalid value supplied for `weighted' argument, please see docs.") 87 } 88 89 n1 <- nrow(incidence) 90 n2 <- ncol(incidence) 91 no.edges <- sum(incidence != 0) 92 if (directed && mode==3) { no.edges <- no.edges * 2 } 93 edges <- numeric(2*no.edges) 94 weight <- numeric(no.edges) 95 ptr <- 1 96 for (i in seq_len(nrow(incidence))) { 97 for (j in seq_len(ncol(incidence))) { 98 if (incidence[i,j] != 0) { 99 if (!directed || mode==1) { 100 edges[2*ptr-1] <- i 101 edges[2*ptr] <- n1+j 102 weight[ptr] <- incidence[i,j] 103 ptr <- ptr + 1 104 } else if (mode==2) { 105 edges[2*ptr-1] <- n1+j 106 edges[2*ptr] <- i 107 weight[ptr] <- incidence[i,j] 108 ptr <- ptr + 1 109 } else if (mode==3) { 110 edges[2*ptr-1] <- i 111 edges[2*ptr] <- n1+j 112 weight[ptr] <- incidence[i,j] 113 ptr <- ptr + 1 114 edges[2*ptr-1] <- n1+j 115 edges[2*ptr] <- i 116 } 117 } 118 } 119 } 120 res <- make_empty_graph(n=n1+n2, directed=directed) 121 weight <- list(weight) 122 names(weight) <- weighted 123 res <- add_edges(res, edges, attr=weight) 124 res <- set_vertex_attr(res, "type", 125 value=c(rep(FALSE, n1), rep(TRUE, n2))) 126 127 } else { 128 129 mode(incidence) <- "double" 130 on.exit( .Call(C_R_igraph_finalizer) ) 131 ## Function call 132 res <- .Call(C_R_igraph_incidence, incidence, directed, mode, multiple) 133 res <- set_vertex_attr(res$graph, "type", value=res$types) 134 135 } 136 137 res 138} 139 140#' Create graphs from an incidence matrix 141#' 142#' \code{graph_from_incidence_matrix} creates a bipartite igraph graph from an incidence 143#' matrix. 144#' 145#' Bipartite graphs have a \sQuote{\code{type}} vertex attribute in igraph, 146#' this is boolean and \code{FALSE} for the vertices of the first kind and 147#' \code{TRUE} for vertices of the second kind. 148#' 149#' \code{graph_from_incidence_matrix} can operate in two modes, depending on the 150#' \code{multiple} argument. If it is \code{FALSE} then a single edge is 151#' created for every non-zero element in the incidence matrix. If 152#' \code{multiple} is \code{TRUE}, then the matrix elements are rounded up to 153#' the closest non-negative integer to get the number of edges to create 154#' between a pair of vertices. 155#' 156#' @aliases graph.incidence 157#' @param incidence The input incidence matrix. It can also be a sparse matrix 158#' from the \code{Matrix} package. 159#' @param directed Logical scalar, whether to create a directed graph. 160#' @param mode A character constant, defines the direction of the edges in 161#' directed graphs, ignored for undirected graphs. If \sQuote{\code{out}}, then 162#' edges go from vertices of the first kind (corresponding to rows in the 163#' incidence matrix) to vertices of the second kind (columns in the incidence 164#' matrix). If \sQuote{\code{in}}, then the opposite direction is used. If 165#' \sQuote{\code{all}} or \sQuote{\code{total}}, then mutual edges are created. 166#' @param multiple Logical scalar, specifies how to interpret the matrix 167#' elements. See details below. 168#' @param weighted This argument specifies whether to create a weighted graph 169#' from the incidence matrix. If it is \code{NULL} then an unweighted graph is 170#' created and the \code{multiple} argument is used to determine the edges of 171#' the graph. If it is a character constant then for every non-zero matrix 172#' entry an edge is created and the value of the entry is added as an edge 173#' attribute named by the \code{weighted} argument. If it is \code{TRUE} then a 174#' weighted graph is created and the name of the edge attribute will be 175#' \sQuote{\code{weight}}. 176#' @param add.names A character constant, \code{NA} or \code{NULL}. 177#' \code{graph_from_incidence_matrix} can add the row and column names of the incidence 178#' matrix as vertex attributes. If this argument is \code{NULL} (the default) 179#' and the incidence matrix has both row and column names, then these are added 180#' as the \sQuote{\code{name}} vertex attribute. If you want a different vertex 181#' attribute for this, then give the name of the attributes as a character 182#' string. If this argument is \code{NA}, then no vertex attributes (other than 183#' type) will be added. 184#' @return A bipartite igraph graph. In other words, an igraph graph that has a 185#' vertex attribute \code{type}. 186#' @author Gabor Csardi \email{csardi.gabor@@gmail.com} 187#' @seealso \code{\link{make_bipartite_graph}} for another way to create bipartite 188#' graphs 189#' @keywords graphs 190#' @examples 191#' 192#' inc <- matrix(sample(0:1, 15, repl=TRUE), 3, 5) 193#' colnames(inc) <- letters[1:5] 194#' rownames(inc) <- LETTERS[1:3] 195#' graph_from_incidence_matrix(inc) 196#' 197graph_from_incidence_matrix <- function(incidence, directed=FALSE, 198 mode=c("all", "out", "in", "total"), 199 multiple=FALSE, weighted=NULL, 200 add.names=NULL) { 201 # Argument checks 202 directed <- as.logical(directed) 203 mode <- switch(igraph.match.arg(mode), "out"=1, "in"=2, "all"=3, "total"=3) 204 multiple <- as.logical(multiple) 205 206 if (inherits(incidence, "Matrix")) { 207 res <- graph.incidence.sparse(incidence, directed=directed, 208 mode=mode, multiple=multiple, 209 weighted=weighted) 210 } else { 211 incidence <- as.matrix(incidence) 212 res <- graph.incidence.dense(incidence, directed=directed, mode=mode, 213 multiple=multiple, weighted=weighted) 214 } 215 216 ## Add names 217 if (is.null(add.names)) { 218 if (!is.null(rownames(incidence)) && !is.null(colnames(incidence))) { 219 add.names <- "name" 220 } else { 221 add.names <- NA 222 } 223 } else if (!is.na(add.names)) { 224 if (is.null(rownames(incidence)) || is.null(colnames(incidence))) { 225 warning("Cannot add row- and column names, at least one of them is missing") 226 add.names <- NA 227 } 228 } 229 if (!is.na(add.names)) { 230 res <- set_vertex_attr(res, add.names, 231 value=c(rownames(incidence), colnames(incidence))) 232 } 233 res 234} 235 236#' @rdname graph_from_incidence_matrix 237#' @param ... Passed to \code{graph_from_incidence_matrix}. 238#' @export 239 240from_incidence_matrix <- function(...) constructor_spec(graph_from_incidence_matrix, ...) 241