1#   IGraph R package
2#   Copyright (C) 2005-2012  Gabor Csardi <csardi.gabor@gmail.com>
3#   334 Harvard street, Cambridge, MA 02139 USA
4#
5#   This program is free software; you can redistribute it and/or modify
6#   it under the terms of the GNU General Public License as published by
7#   the Free Software Foundation; either version 2 of the License, or
8#   (at your option) any later version.
9#
10#   This program is distributed in the hope that it will be useful,
11#   but WITHOUT ANY WARRANTY; without even the implied warranty of
12#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
13#   GNU General Public License for more details.
14#
15#   You should have received a copy of the GNU General Public License
16#   along with this program; if not, write to the Free Software
17#   Foundation, Inc.,  51 Franklin Street, Fifth Floor, Boston, MA
18#   02110-1301 USA
19#
20###################################################################
21
22get.adjacency.dense <- function(graph, type=c("both", "upper", "lower"),
23                                attr=NULL, edges=FALSE, names=TRUE) {
24
25  if (!is_igraph(graph)) {
26    stop("Not a graph object")
27  }
28
29  type <- igraph.match.arg(type)
30  type <- switch(type, "upper"=0, "lower"=1, "both"=2)
31
32  if (edges || is.null(attr)) {
33    on.exit( .Call(C_R_igraph_finalizer) )
34    res <- .Call(C_R_igraph_get_adjacency, graph, as.numeric(type),
35                 as.logical(edges))
36  } else {
37    attr <- as.character(attr)
38    if (! attr %in% edge_attr_names(graph)) {
39      stop("no such edge attribute")
40    }
41    exattr <- edge_attr(graph, attr)
42    if (is.logical(exattr)) {
43      res <- matrix(FALSE, nrow=vcount(graph), ncol=vcount(graph))
44    } else if (is.character(exattr)) {
45      res <- matrix("", nrow=vcount(graph), ncol=vcount(graph))
46    } else if (is.numeric(exattr)) {
47      res <- matrix(0, nrow=vcount(graph), ncol=vcount(graph))
48    } else {
49      stop("Sparse matrices must be either numeric or logical,",
50           "and the edge attribute is not")
51    }
52    if (is_directed(graph)) {
53      for (i in seq(length=ecount(graph))) {
54        e <- ends(graph, i, names = FALSE)
55        res[ e[1], e[2] ] <- edge_attr(graph, attr, i)
56      }
57    } else {
58      if (type==0) {
59        ## upper
60        for (i in seq(length=ecount(graph))) {
61          e <- ends(graph, i, names = FALSE)
62          res[ min(e), max(e) ] <- edge_attr(graph, attr, i)
63        }
64      } else if (type==1) {
65        ## lower
66        for (i in seq(length=ecount(graph))) {
67          e <- ends(graph, i, names = FALSE)
68          res[ max(e), min(e) ] <- edge_attr(graph, attr, i)
69        }
70      } else if (type==2) {
71        ## both
72        for (i in seq(length=ecount(graph))) {
73          e <- ends(graph, i, names = FALSE)
74          res[ e[1], e[2] ] <- edge_attr(graph, attr, i)
75          if (e[1] != e[2]) {
76            res[ e[2], e[1] ] <- edge_attr(graph, attr, i)
77          }
78        }
79      }
80    }
81  }
82
83  if (names && "name" %in% vertex_attr_names(graph)) {
84    colnames(res) <- rownames(res) <- V(graph)$name
85  }
86
87  res
88}
89
90get.adjacency.sparse <- function(graph, type=c("both", "upper", "lower"),
91                                 attr=NULL, edges=FALSE, names=TRUE) {
92
93  if (!is_igraph(graph)) {
94    stop("Not a graph object")
95  }
96
97  type <- igraph.match.arg(type)
98
99  vc <- vcount(graph)
100
101  el <- as_edgelist(graph, names=FALSE)
102  if (edges) {
103    value <- seq_len(nrow(el))
104  } else if (!is.null(attr)) {
105    attr <- as.character(attr)
106    if (!attr %in% edge_attr_names(graph)) {
107      stop("no such edge attribute")
108    }
109    value <- edge_attr(graph, name=attr)
110    if (!is.numeric(value) && !is.logical(value)) {
111      stop("Sparse matrices must be either numeric or logical,",
112           "and the edge attribute is not")
113    }
114  } else {
115    value <- rep(1, nrow(el))
116  }
117
118  if (is_directed(graph)) {
119    res <- Matrix::sparseMatrix(dims=c(vc, vc), i=el[,1], j=el[,2], x=value)
120  } else {
121    if (type=="upper") {
122      ## upper
123      res <- Matrix::sparseMatrix(dims=c(vc, vc), i=pmin(el[,1],el[,2]),
124                          j=pmax(el[,1],el[,2]), x=value)
125    } else if (type=="lower") {
126      ## lower
127      res <- Matrix::sparseMatrix(dims=c(vc, vc), i=pmax(el[,1],el[,2]),
128                          j=pmin(el[,1],el[,2]), x=value)
129    } else if (type=="both") {
130      ## both
131      res <- Matrix::sparseMatrix(dims=c(vc, vc), i=pmin(el[,1],el[,2]),
132                          j=pmax(el[,1],el[,2]), x=value, symmetric=TRUE)
133      res <- as(res, "dgCMatrix")
134    }
135  }
136
137  if (names && "name" %in% vertex_attr_names(graph)) {
138    colnames(res) <- rownames(res) <- V(graph)$name
139  }
140
141  res
142}
143
144#' Convert a graph to an adjacency matrix
145#'
146#' Sometimes it is useful to work with a standard representation of a
147#' graph, like an adjacency matrix.
148#'
149#' \code{as_adjacency_matrix} returns the adjacency matrix of a graph, a
150#' regular matrix if \code{sparse} is \code{FALSE}, or a sparse matrix, as
151#' defined in the \sQuote{\code{Matrix}} package, if \code{sparse} if
152#' \code{TRUE}.
153#'
154#' @aliases get.adjacency
155#' @param graph The graph to convert.
156#' @param type Gives how to create the adjacency matrix for undirected graphs.
157#' It is ignored for directed graphs. Possible values: \code{upper}: the upper
158#' right triangle of the matrix is used, \code{lower}: the lower left triangle
159#' of the matrix is used. \code{both}: the whole matrix is used, a symmetric
160#' matrix is returned.
161#' @param attr Either \code{NULL} or a character string giving an edge
162#' attribute name. If \code{NULL} a traditional adjacency matrix is returned.
163#' If not \code{NULL} then the values of the given edge attribute are included
164#' in the adjacency matrix. If the graph has multiple edges, the edge attribute
165#' of an arbitrarily chosen edge (for the multiple edges) is included. This
166#' argument is ignored if \code{edges} is \code{TRUE}.
167#'
168#' Note that this works only for certain attribute types. If the \code{sparse}
169#' argumen is \code{TRUE}, then the attribute must be either logical or
170#' numeric. If the \code{sparse} argument is \code{FALSE}, then character is
171#' also allowed. The reason for the difference is that the \code{Matrix}
172#' package does not support character sparse matrices yet.
173#' @param edges Logical scalar, whether to return the edge ids in the matrix.
174#' For non-existant edges zero is returned.
175#' @param names Logical constant, whether to assign row and column names
176#' to the matrix. These are only assigned if the \code{name} vertex attribute
177#' is present in the graph.
178#' @param sparse Logical scalar, whether to create a sparse matrix. The
179#' \sQuote{\code{Matrix}} package must be installed for creating sparse
180#' matrices.
181#' @return A \code{vcount(graph)} by \code{vcount(graph)} (usually) numeric
182#' matrix.
183#'
184#' @seealso \code{\link{graph_from_adjacency_matrix}}, \code{\link{read_graph}}
185#' @examples
186#'
187#' g <- sample_gnp(10, 2/10)
188#' as_adjacency_matrix(g)
189#' V(g)$name <- letters[1:vcount(g)]
190#' as_adjacency_matrix(g)
191#' E(g)$weight <- runif(ecount(g))
192#' as_adjacency_matrix(g, attr="weight")
193#' @export
194
195as_adjacency_matrix <- function(graph, type=c("both", "upper", "lower"),
196                                attr=NULL, edges=FALSE, names=TRUE,
197                                sparse=igraph_opt("sparsematrices")) {
198  if (!is_igraph(graph)) {
199    stop("Not a graph object")
200  }
201
202  if (!sparse) {
203    get.adjacency.dense(graph, type=type, attr=attr, edges=edges, names=names)
204  } else {
205    get.adjacency.sparse(graph, type=type, attr=attr, edges=edges, names=names)
206  }
207}
208
209#' @export
210#' @rdname as_adjacency_matrix
211
212as_adj <- as_adjacency_matrix
213
214#' Convert a graph to an edge list
215#'
216#' Sometimes it is useful to work with a standard representation of a
217#' graph, like an edge list.
218#'
219#' \code{as_edgelist} returns the list of edges in a graph.
220#'
221#' @aliases get.edgelist
222#' @param graph The graph to convert.
223#' @param names Whether to return a character matrix containing vertex
224#' names (ie. the \code{name} vertex attribute) if they exist or numeric
225#' vertex ids.
226#' @return A \code{gsize(graph)} by 2 numeric matrix.
227#' @seealso \code{\link{graph_from_adjacency_matrix}}, \code{\link{read_graph}}
228#' @keywords graphs
229#' @examples
230#'
231#' g <- sample_gnp(10, 2/10)
232#' as_edgelist(g)
233#'
234#' V(g)$name <- LETTERS[seq_len(gorder(g))]
235#' as_edgelist(g)
236#'
237#' @export
238
239as_edgelist <- function(graph, names=TRUE) {
240  if (!is_igraph(graph)) {
241    stop("Not a graph object")
242  }
243  on.exit( .Call(C_R_igraph_finalizer) )
244  res <- matrix(.Call(C_R_igraph_get_edgelist, graph, TRUE),
245                ncol=2)
246  res <- res+1
247  if (names && "name" %in% vertex_attr_names(graph)) {
248    res <- matrix(V(graph)$name[ res ], ncol=2)
249  }
250
251  res
252}
253
254
255
256#' Convert between directed and undirected graphs
257#'
258#' \code{as.directed} converts an undirected graph to directed,
259#' \code{as.undirected} does the opposite, it converts a directed graph to
260#' undirected.
261#'
262#' Conversion algorithms for \code{as.directed}: \describe{
263#' \item{"arbitrary"}{The number of edges in the graph stays the same, an
264#' arbitrarily directed edge is created for each undirected edge.}
265#' \item{"mutual"}{Two directed edges are created for each undirected
266#' edge, one in each direction.} }
267#'
268#' Conversion algorithms for \code{as.undirected}: \describe{
269#' \item{"each"}{The number of edges remains constant, an undirected edge
270#' is created for each directed one, this version might create graphs with
271#' multiple edges.} \item{"collapse"}{One undirected edge will be created
272#' for each pair of vertices which are connected with at least one directed
273#' edge, no multiple edges will be created.} \item{"mutual"}{One
274#' undirected edge will be created for each pair of mutual edges. Non-mutual
275#' edges are ignored. This mode might create multiple edges if there are more
276#' than one mutual edge pairs between the same pair of vertices.  } }
277#'
278#' @aliases as.directed as.undirected
279#' @param graph The graph to convert.
280#' @param mode Character constant, defines the conversion algorithm. For
281#' \code{as.directed} it can be \code{mutual} or \code{arbitrary}. For
282#' \code{as.undirected} it can be \code{each}, \code{collapse} or
283#' \code{mutual}. See details below.
284#' @return A new graph object.
285#' @author Gabor Csardi \email{csardi.gabor@@gmail.com}
286#' @seealso \code{\link{simplify}} for removing multiple and/or loop edges from
287#' a graph.
288#' @export
289#' @keywords graphs
290#' @examples
291#'
292#' g <- make_ring(10)
293#' as.directed(g, "mutual")
294#' g2 <- make_star(10)
295#' as.undirected(g)
296#'
297#' # Combining edge attributes
298#' g3 <- make_ring(10, directed=TRUE, mutual=TRUE)
299#' E(g3)$weight <- seq_len(ecount(g3))
300#' ug3 <- as.undirected(g3)
301#' print(ug3, e=TRUE)
302#' \dontrun{
303#'   x11(width=10, height=5)
304#'   layout(rbind(1:2))
305#'   plot( g3, layout=layout_in_circle, edge.label=E(g3)$weight)
306#'   plot(ug3, layout=layout_in_circle, edge.label=E(ug3)$weight)
307#' }
308#'
309#' g4 <- graph(c(1,2, 3,2,3,4,3,4, 5,4,5,4,
310#'               6,7, 7,6,7,8,7,8, 8,7,8,9,8,9,
311#'               9,8,9,8,9,9, 10,10,10,10))
312#' E(g4)$weight <- seq_len(ecount(g4))
313#' ug4 <- as.undirected(g4, mode="mutual",
314#'               edge.attr.comb=list(weight=length))
315#' print(ug4, e=TRUE)
316#'
317as.directed <- function(graph, mode=c("mutual", "arbitrary")) {
318  if (!is_igraph(graph)) {
319    stop("Not a graph object")
320  }
321
322  mode <- igraph.match.arg(mode)
323  mode <- switch(mode, "arbitrary"=0, "mutual"=1)
324
325  on.exit( .Call(C_R_igraph_finalizer) )
326  .Call(C_R_igraph_to_directed, graph, as.numeric(mode))
327}
328
329#' @rdname as.directed
330#' @param edge.attr.comb Specifies what to do with edge attributes, if
331#' \code{mode="collapse"} or \code{mode="mutual"}.  In these cases many edges
332#' might be mapped to a single one in the new graph, and their attributes are
333#' combined. Please see \code{\link{attribute.combination}} for details on
334#' this.
335#' @export
336
337as.undirected <- function(graph, mode=c("collapse", "each", "mutual"), edge.attr.comb=igraph_opt("edge.attr.comb")) {
338  # Argument checks
339  if (!is_igraph(graph)) { stop("Not a graph object") }
340  mode <- switch(igraph.match.arg(mode), "collapse"=1, "each"=0, "mutual"=2)
341  edge.attr.comb <- igraph.i.attribute.combination(edge.attr.comb)
342
343  on.exit( .Call(C_R_igraph_finalizer) )
344  # Function call
345  res <- .Call(C_R_igraph_to_undirected, graph, mode, edge.attr.comb)
346
347  res
348}
349
350
351#' Adjacency lists
352#'
353#' Create adjacency lists from a graph, either for adjacent edges or for
354#' neighboring vertices
355#'
356#' \code{as_adj_list} returns a list of numeric vectors, which include the ids
357#' of neighbor vertices (according to the \code{mode} argument) of all
358#' vertices.
359#'
360#' \code{as_adj_edge_list} returns a list of numeric vectors, which include the
361#' ids of adjacent edgs (according to the \code{mode} argument) of all
362#' vertices.
363#'
364#' @aliases as_adj_list get.adjedgelist
365#' @param graph The input graph.
366#' @param mode Character scalar, it gives what kind of adjacent edges/vertices
367#' to include in the lists. \sQuote{\code{out}} is for outgoing edges/vertices,
368#' \sQuote{\code{in}} is for incoming edges/vertices, \sQuote{\code{all}} is
369#' for both. This argument is ignored for undirected graphs.
370#' @return A list of numeric vectors.
371#' @author Gabor Csardi \email{csardi.gabor@@gmail.com}
372#' @seealso \code{\link{as_edgelist}}, \code{\link{as_adj}}
373#' @export
374#' @keywords graphs
375#' @examples
376#'
377#' g <- make_ring(10)
378#' as_adj_list(g)
379#' as_adj_edge_list(g)
380#'
381as_adj_list <- function(graph, mode=c("all", "out", "in", "total")) {
382  if (!is_igraph(graph)) {
383    stop("Not a graph object")
384  }
385
386  mode <- igraph.match.arg(mode)
387  mode <- as.numeric(switch(mode, "out"=1, "in"=2, "all"=3, "total"=3))
388  on.exit( .Call(C_R_igraph_finalizer) )
389  res <- .Call(C_R_igraph_get_adjlist, graph, mode)
390  res <- lapply(res, function(x) V(graph)[x + 1])
391  if (is_named(graph)) names(res) <- V(graph)$name
392  res
393}
394
395#' @rdname as_adj_list
396#' @aliases get.adjlist
397#' @export
398
399as_adj_edge_list <- function(graph, mode=c("all", "out", "in", "total")) {
400  if (!is_igraph(graph)) {
401    stop("Not a graph object")
402  }
403
404  mode <- igraph.match.arg(mode)
405  mode <- as.numeric(switch(mode, "out"=1, "in"=2, "all"=3, "total"=3))
406  on.exit( .Call(C_R_igraph_finalizer) )
407  res <- .Call(C_R_igraph_get_adjedgelist, graph, mode)
408  res <- lapply(res, function(x) E(graph)[x + 1])
409  if (is_named(graph)) names(res) <- V(graph)$name
410  res
411}
412
413#' Convert graphNEL objects from the graph package to igraph
414#'
415#' The graphNEL class is defined in the \code{graph} package, it is another
416#' way to represent graphs. \code{graph_from_graphnel} takes a graphNEL
417#' graph and converts it to an igraph graph. It handles all
418#' graph/vertex/edge attributes. If the graphNEL graph has a vertex
419#' attribute called \sQuote{\code{name}} it will be used as igraph vertex
420#' attribute \sQuote{\code{name}} and the graphNEL vertex names will be
421#' ignored.
422#'
423#' Because graphNEL graphs poorly support multiple edges, the edge
424#' attributes of the multiple edges are lost: they are all replaced by the
425#' attributes of the first of the multiple edges.
426#'
427#' @aliases igraph.from.graphNEL
428#' @param graphNEL The graphNEL graph.
429#' @param name Logical scalar, whether to add graphNEL vertex names as an
430#' igraph vertex attribute called \sQuote{\code{name}}.
431#' @param weight Logical scalar, whether to add graphNEL edge weights as an
432#' igraph edge attribute called \sQuote{\code{weight}}. (graphNEL graphs are
433#' always weighted.)
434#' @param unlist.attrs Logical scalar. graphNEL attribute query functions
435#' return the values of the attributes in R lists, if this argument is
436#' \code{TRUE} (the default) these will be converted to atomic vectors,
437#' whenever possible, before adding them to the igraph graph.
438#' @return \code{graph_from_graphnel} returns an igraph graph object.
439#' @seealso \code{\link{as_graphnel}} for the other direction,
440#' \code{\link{as_adj}}, \code{\link{graph_from_adjacency_matrix}},
441#' \code{\link{as_adj_list}} and \code{\link{graph.adjlist}} for other
442#' graph representations.
443#' @examples
444#' \dontrun{
445#' ## Undirected
446#' g <- make_ring(10)
447#' V(g)$name <- letters[1:10]
448#' GNEL <- as_graphnel(g)
449#' g2 <- graph_from_graphnel(GNEL)
450#' g2
451#'
452#' ## Directed
453#' g3 <- make_star(10, mode="in")
454#' V(g3)$name <- letters[1:10]
455#' GNEL2 <- as_graphnel(g3)
456#' g4 <- graph_from_graphnel(GNEL2)
457#' g4
458#' }
459#' @export
460
461graph_from_graphnel <- function(graphNEL, name=TRUE, weight=TRUE,
462                                 unlist.attrs=TRUE) {
463
464  if (!inherits(graphNEL, "graphNEL")) {
465    stop("Not a graphNEL graph")
466  }
467
468  al <- lapply(graph::edgeL(graphNEL), "[[", "edges")
469  if (graph::edgemode(graphNEL)=="undirected") {
470    al <- mapply(SIMPLIFY=FALSE, seq_along(al), al, FUN=function(n, l) {
471      c(l, rep(n, sum(l==n)))
472    })
473  }
474  mode <- if (graph::edgemode(graphNEL)=="directed") "out" else "all"
475  g <- graph_from_adj_list(al, mode=mode, duplicate=TRUE)
476  if (name) {
477    V(g)$name <- graph::nodes(graphNEL)
478  }
479
480  ## Graph attributes
481  g.n <- names(graphNEL@graphData)
482  g.n <- g.n [ g.n != "edgemode" ]
483  for (n in g.n) {
484    g <- set_graph_attr(g, n, graphNEL@graphData[[n]])
485  }
486
487  ## Vertex attributes
488  v.n <- names(graph::nodeDataDefaults(graphNEL))
489  for (n in v.n) {
490    val <- unname(graph::nodeData(graphNEL, attr=n))
491    if (unlist.attrs && all(sapply(val, length)==1)) { val <- unlist(val) }
492    g <- set_vertex_attr(g, n, value=val)
493  }
494
495  ## Edge attributes
496  e.n <- names(graph::edgeDataDefaults(graphNEL))
497  if (!weight) { e.n <- e.n [ e.n != "weight" ] }
498  if (length(e.n) > 0) {
499    el <- as_edgelist(g)
500    el <- paste(sep="|", el[,1], el[,2])
501    for (n in e.n) {
502      val <- unname(graph::edgeData(graphNEL, attr=n)[el])
503      if (unlist.attrs && all(sapply(val, length)==1)) { val <- unlist(val) }
504      g <- set_edge_attr(g, n, value=val)
505    }
506  }
507
508  g
509}
510
511#' Convert igraph graphs to graphNEL objects from the graph package
512#'
513#' The graphNEL class is defined in the \code{graph} package, it is another
514#' way to represent graphs. These functions are provided to convert between
515#' the igraph and the graphNEL objects.
516#'
517#' \code{as_graphnel} converts an igraph graph to a graphNEL graph. It
518#' converts all graph/vertex/edge attributes. If the igraph graph has a
519#' vertex attribute \sQuote{\code{name}}, then it will be used to assign
520#' vertex names in the graphNEL graph. Otherwise numeric igraph vertex ids
521#' will be used for this purpose.
522#'
523#' @aliases igraph.to.graphNEL
524#' @param graph An igraph graph object.
525#' @return \code{as_graphnel} returns a graphNEL graph object.
526#' @seealso \code{\link{graph_from_graphnel}} for the other direction,
527#' \code{\link{as_adj}}, \code{\link{graph_from_adjacency_matrix}},
528#' \code{\link{as_adj_list}} and \code{\link{graph.adjlist}} for
529#' other graph representations.
530#' @examples
531#' ## Undirected
532#' \dontrun{
533#' g <- make_ring(10)
534#' V(g)$name <- letters[1:10]
535#' GNEL <- as_graphnel(g)
536#' g2 <- graph_from_graphnel(GNEL)
537#' g2
538#'
539#' ## Directed
540#' g3 <- make_star(10, mode="in")
541#' V(g3)$name <- letters[1:10]
542#' GNEL2 <- as_graphnel(g3)
543#' g4 <- graph_from_graphnel(GNEL2)
544#' g4
545#' }
546#' @export
547
548as_graphnel <- function(graph) {
549
550  if (!is_igraph(graph)) {
551    stop("Not an igraph graph")
552  }
553
554  if ("name" %in% vertex_attr_names(graph) &&
555      is.character(V(graph)$name)) {
556    name <- V(graph)$name
557  } else {
558    name <- as.character(seq(vcount(graph)))
559  }
560
561  edgemode <- if (is_directed(graph)) "directed" else "undirected"
562
563  if ("weight" %in% edge_attr_names(graph) &&
564      is.numeric(E(graph)$weight)) {
565    al <- lapply(as_adj_edge_list(graph, "out"), as.vector)
566    for (i in seq(along=al)) {
567      edges <- ends(graph, al[[i]], names = FALSE)
568      edges <- ifelse( edges[,2]==i, edges[,1], edges[,2])
569      weights <- E(graph)$weight[al[[i]]]
570      al[[i]] <- list(edges=edges, weights=weights)
571    }
572  } else {
573    al <- as_adj_list(graph, "out")
574    al <- lapply(al, function(x) list(edges=as.vector(x)))
575  }
576
577  names(al) <- name
578  res <- graph::graphNEL(nodes=name, edgeL=al, edgemode=edgemode)
579
580  ## Add graph attributes (other than 'directed')
581  ## Are this "officially" supported at all?
582
583  g.n <- graph_attr_names(graph)
584  if ("directed" %in% g.n) {
585    warning("Cannot add graph attribute `directed'")
586    g.n <- g.n[ g.n != "directed" ]
587  }
588  for (n in g.n) {
589    res@graphData[[n]] <- graph_attr(graph, n)
590  }
591
592  ## Add vertex attributes (other than 'name', that is already
593  ## added as vertex names)
594
595  v.n <- vertex_attr_names(graph)
596  v.n <- v.n[ v.n != "name" ]
597  for (n in v.n) {
598    graph::nodeDataDefaults(res, attr=n) <- NA
599    graph::nodeData(res, attr=n) <- vertex_attr(graph, n)
600  }
601
602  ## Add edge attributes (other than 'weight')
603
604  e.n <- edge_attr_names(graph)
605  e.n <- e.n[ e.n != "weight" ]
606  if (length(e.n) > 0) {
607    el <- as_edgelist(graph)
608    el <- paste(sep="|", el[,1], el[,2])
609    for (n in e.n) {
610      graph::edgeDataDefaults(res, attr=n) <- NA
611      res@edgeData@data[el] <- mapply(function(x,y) {
612        xx <- c(x,y); names(xx)[length(xx)] <- n; xx },
613                                      res@edgeData@data[el],
614                                      edge_attr(graph, n),
615                                      SIMPLIFY=FALSE)
616    }
617  }
618
619  res
620}
621
622get.incidence.dense <- function(graph, types, names, attr) {
623
624  if (is.null(attr)) {
625    on.exit( .Call(C_R_igraph_finalizer) )
626    ## Function call
627    res <- .Call(C_R_igraph_get_incidence, graph, types)
628
629    if (names && "name" %in% vertex_attr_names(graph)) {
630      rownames(res$res) <- V(graph)$name[ res$row_ids+1 ]
631      colnames(res$res) <- V(graph)$name[ res$col_ids+1 ]
632    } else {
633      rownames(res$res) <- res$row_ids+1
634      colnames(res$res) <- res$col_ids+1
635    }
636    res$res
637
638  } else {
639
640    attr <- as.character(attr)
641    if (!attr %in% edge_attr_names(graph)) {
642      stop("no such edge attribute")
643    }
644
645    vc <- vcount(graph)
646    n1 <- sum(!types)
647    n2 <- vc-n1
648    res <- matrix(0, n1, n2)
649
650    recode <- numeric(vc)
651    recode[!types] <- seq_len(n1)
652    recode[types]  <- seq_len(n2)
653
654    for (i in seq(length=ecount(graph))) {
655      eo <- ends(graph, i, names = FALSE)
656      e <- recode[eo]
657      if (!types[eo[1]]) {
658        res[ e[1], e[2] ] <- edge_attr(graph, attr, i)
659      } else{
660        res[ e[2], e[1] ] <- edge_attr(graph, attr, i)
661      }
662    }
663
664    if (names && "name" %in% vertex_attr_names(graph)) {
665      rownames(res) <- V(graph)$name[ which(!types) ]
666      colnames(res) <- V(graph)$name[ which( types) ]
667    } else {
668      rownames(res) <- which(!types)
669      colnames(res) <- which(types)
670    }
671
672    res
673  }
674}
675
676get.incidence.sparse <- function(graph, types, names, attr) {
677
678  vc <- vcount(graph)
679  if (length(types) != vc) {
680    stop("Invalid types vector")
681  }
682
683  el <- as_edgelist(graph, names=FALSE)
684  if (any(types[el[,1]] == types[el[,2]])) {
685    stop("Invalid types vector, not a bipartite graph")
686  }
687
688  n1 <- sum(!types)
689  n2 <- vc-n1
690
691  recode <- numeric(vc)
692  recode[!types] <- seq_len(n1)
693  recode[types]  <- seq_len(n2) + n1
694
695  el[,1] <- recode[el[,1]]
696  el[,2] <- recode[el[,2]]
697
698  change <- el[,1] > n1
699  el[change,] <- el[change,2:1]
700  el[,2] <- el[,2]-n1
701
702  if (!is.null(attr)) {
703    attr <- as.character(attr)
704    if (!attr %in% edge_attr_names(graph)) {
705      stop("no such edge attribute")
706    }
707    value <- edge_attr(graph, name=attr)
708  } else {
709    value <- rep(1, nrow(el))
710  }
711
712  res <- Matrix::spMatrix(n1, n2, i=el[,1], j=el[,2], x=value)
713
714  if (names && "name" %in% vertex_attr_names(graph)) {
715    rownames(res) <- V(graph)$name[which(!types)]
716    colnames(res) <- V(graph)$name[which(types)]
717  } else {
718    rownames(res) <- which(!types)
719    colnames(res) <- which(types)
720  }
721  res
722}
723
724
725
726#' Incidence matrix of a bipartite graph
727#'
728#' This function can return a sparse or dense incidence matrix of a bipartite
729#' network. The incidence matrix is an \eqn{n} times \eqn{m} matrix, \eqn{n}
730#' and \eqn{m} are the number of vertices of the two kinds.
731#'
732#' Bipartite graphs have a \code{type} vertex attribute in igraph, this is
733#' boolean and \code{FALSE} for the vertices of the first kind and \code{TRUE}
734#' for vertices of the second kind.
735#'
736#' @aliases get.incidence
737#' @param graph The input graph. The direction of the edges is ignored in
738#' directed graphs.
739#' @param types An optional vertex type vector to use instead of the
740#' \code{type} vertex attribute. You must supply this argument if the graph has
741#' no \code{type} vertex attribute.
742#' @param attr Either \code{NULL} or a character string giving an edge
743#' attribute name. If \code{NULL}, then a traditional incidence matrix is
744#' returned. If not \code{NULL} then the values of the given edge attribute are
745#' included in the incidence matrix. If the graph has multiple edges, the edge
746#' attribute of an arbitrarily chosen edge (for the multiple edges) is
747#' included.
748#' @param names Logical scalar, if \code{TRUE} and the vertices in the graph
749#' are named (i.e. the graph has a vertex attribute called \code{name}), then
750#' vertex names will be added to the result as row and column names. Otherwise
751#' the ids of the vertices are used as row and column names.
752#' @param sparse Logical scalar, if it is \code{TRUE} then a sparse matrix is
753#' created, you will need the \code{Matrix} package for this.
754#' @return A sparse or dense matrix.
755#' @author Gabor Csardi \email{csardi.gabor@@gmail.com}
756#' @seealso \code{\link{graph_from_incidence_matrix}} for the opposite operation.
757#' @export
758#' @keywords graphs
759#' @examples
760#'
761#' g <- make_bipartite_graph( c(0,1,0,1,0,0), c(1,2,2,3,3,4) )
762#' as_incidence_matrix(g)
763#'
764as_incidence_matrix <- function(graph, types=NULL, attr=NULL,
765                          names=TRUE, sparse=FALSE) {
766  # Argument checks
767  if (!is_igraph(graph)) { stop("Not a graph object") }
768  if (is.null(types) && "type" %in% vertex_attr_names(graph)) {
769    types <- V(graph)$type
770  }
771  if (!is.null(types)) {
772    types <- as.logical(types)
773  } else {
774    stop("Not a bipartite graph, supply `types' argument")
775  }
776
777  names <- as.logical(names)
778  sparse <- as.logical(sparse)
779
780  if (sparse) {
781    get.incidence.sparse(graph, types=types, names=names, attr=attr)
782  } else {
783    get.incidence.dense(graph, types=types, names=names, attr=attr)
784  }
785}
786
787#' @rdname graph_from_data_frame
788#' @param x An igraph object.
789#' @param what Character constant, whether to return info about vertices,
790#' edges, or both. The default is \sQuote{edges}.
791#' @export
792
793as_data_frame <- function(x, what=c("edges", "vertices", "both")) {
794
795  if (!is_igraph(x)) { stop("Not a graph object") }
796  what <- igraph.match.arg(what)
797
798  if (what %in% c("vertices", "both")) {
799    ver <- .Call(C_R_igraph_mybracket2, x, 9L, 3L)
800    class(ver) <- "data.frame"
801    rn <- if (is_named(x)) { V(x)$name } else { seq_len(vcount(x)) }
802    rownames(ver) <- rn
803  }
804
805  if (what %in% c("edges", "both")) {
806    el <- as_edgelist(x)
807    edg <- c(list(from=el[,1]), list(to=el[,2]),
808             .Call(C_R_igraph_mybracket2, x, 9L, 4L))
809    class(edg) <- "data.frame"
810    rownames(edg) <- seq_len(ecount(x))
811  }
812
813  if (what=="both") {
814    list(vertices=ver, edges=edg)
815  } else if (what=="vertices") {
816    ver
817  } else {
818    edg
819  }
820}
821
822
823#' Create graphs from adjacency lists
824#'
825#' An adjacency list is a list of numeric vectors, containing the neighbor
826#' vertices for each vertex. This function creates an igraph graph object from
827#' such a list.
828#'
829#' Adjacency lists are handy if you intend to do many (small) modifications to
830#' a graph. In this case adjacency lists are more efficient than igraph graphs.
831#'
832#' The idea is that you convert your graph to an adjacency list by
833#' \code{\link{as_adj_list}}, do your modifications to the graphs and finally
834#' create again an igraph graph by calling \code{graph_from_adj_list}.
835#'
836#' @aliases graph.adjlist graph_from_adj_list
837#' @param adjlist The adjacency list. It should be consistent, i.e. the maximum
838#' throughout all vectors in the list must be less than the number of vectors
839#' (=the number of vertices in the graph). Note that the list is expected to be
840#' 0-indexed.
841#' @param mode Character scalar, it specifies whether the graph to create is
842#' undirected (\sQuote{all} or \sQuote{total}) or directed; and in the latter
843#' case, whether it contains the outgoing (\sQuote{out}) or the incoming
844#' (\sQuote{in}) neighbors of the vertices.
845#' @param duplicate Logical scalar. For undirected graphs it gives whether
846#' edges are included in the list twice. E.g. if it is \code{TRUE} then for an
847#' undirected \code{{A,B}} edge \code{graph_from_adj_list} expects \code{A}
848#' included in the neighbors of \code{B} and \code{B} to be included in the
849#' neighbors of \code{A}.
850#'
851#' This argument is ignored if \code{mode} is \code{out} or \code{in}.
852#' @return An igraph graph object.
853#' @author Gabor Csardi \email{csardi.gabor@@gmail.com}
854#' @seealso \code{\link{as_edgelist}}
855#' @keywords graphs
856#' @examples
857#'
858#' ## Directed
859#' g <- make_ring(10, dir=TRUE)
860#' al <- as_adj_list(g, mode="out")
861#' g2 <- graph_from_adj_list(al)
862#' graph.isomorphic(g, g2)
863#'
864#' ## Undirected
865#' g <- make_ring(10)
866#' al <- as_adj_list(g)
867#' g2 <- graph_from_adj_list(al, mode="all")
868#' graph.isomorphic(g, g2)
869#' ecount(g2)
870#' g3 <- graph_from_adj_list(al, mode="all", duplicate=FALSE)
871#' ecount(g3)
872#' which_multiple(g3)
873#' @export
874
875graph_from_adj_list <- graph_from_adj_list
876
877
878#' Convert a graph to a long data frame
879#'
880#' A long data frame contains all metadata about both the vertices
881#' and edges of the graph. It contains one row for each edge, and
882#' all metadata about that edge and its incident vertices are included
883#' in that row. The names of the columns that contain the metadata
884#' of the incident vertices are prefixed with \code{from_} and \code{to_}.
885#' The first two columns are always named \code{from} and \code{to} and
886#' they contain the numeric ids of the incident vertices. The rows are
887#' listed in the order of numeric vertex ids.
888#'
889#' @param graph Input graph
890#' @return A long data frame.
891#'
892#' @export
893#' @examples
894#' g <- make_(ring(10),
895#'         with_vertex_(name = letters[1:10], color = "red"),
896#'         with_edge_(weight = 1:10, color = "green")
897#'       )
898#' as_long_data_frame(g)
899
900as_long_data_frame <- function(graph) {
901
902  if (!is_igraph(graph)) { stop("Not a graph object") }
903
904  ver <- .Call(C_R_igraph_mybracket2, graph, 9L, 3L)
905  class(ver) <- "data.frame"
906  rn <- if (is_named(graph)) { V(graph)$name } else { seq_len(vcount(graph)) }
907  rownames(ver) <- rn
908
909  el <- as_edgelist(graph, names = FALSE)
910  edg <- c(list(from=el[,1]), list(to=el[,2]),
911           .Call(C_R_igraph_mybracket2, graph, 9L, 4L))
912  class(edg) <- "data.frame"
913  rownames(edg) <- seq_len(ecount(graph))
914
915  ver2 <- ver
916  names(ver) <- paste0("from_", names(ver))
917  names(ver2) <- paste0("to_", names(ver2))
918
919  edg <- cbind(edg, ver[ el[,1], ], ver2[ el[,2], ])
920
921  edg
922}
923