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