1#   IGraph R package
2#   Copyright (C) 2006-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
22rename.attr.if.needed <- function(type, graphs, newsize=NULL, maps=NULL,
23                                  maps2=NULL, ignore=character()) {
24  listfun <- switch(type, "g"=graph_attr_names,
25                    "v"=vertex_attr_names, "e"=edge_attr_names,
26                    stop("Internal igraph error"))
27  getfun <- switch(type, "g"=graph_attr, "v"=vertex_attr,
28                   "e"=edge_attr, stop("Internal igraph error"))
29  alist <- lapply(graphs, listfun)
30  an <- unique(unlist(alist))
31  an <- setdiff(an, ignore)
32
33  getval <- function(which, name) {
34    newval <- getfun(graphs[[which]], name)
35    if (!is.null(maps)) {
36      tmpval <- newval[ maps[[which]] >= 0 ]
37      mm <- maps[[which]][ maps[[which]] >= 0 ] + 1
38      newval <- rep(NA, newsize)
39      newval[mm] <- tmpval
40    }
41    if (!is.null(maps2)) {
42      newval <- newval[ maps2[[which]] + 1 ]
43    }
44    if (!is.null(newsize)) { length(newval) <- newsize }
45    newval
46  }
47
48  attr <- list()
49  for (name in an) {
50    w <- which(sapply(alist, function(x) name %in% x))
51    if (length(w)==1) {
52      attr[[name]] <- getval(w, name)
53    } else {
54      for (w2 in w) {
55        nname <- paste(name, sep="_", w2)
56        newval <- getval(w2, name)
57        attr[[nname]] <-newval
58      }
59    }
60  }
61  attr
62}
63
64
65
66#' Disjoint union of graphs
67#'
68#' The union of two or more graphs are created. The graphs are assumed to have
69#' disjoint vertex sets.
70#'
71#' \code{disjoint_union} creates a union of two or more disjoint graphs.
72#' Thus first the vertices in the second, third, etc. graphs are relabeled to
73#' have completely disjoint graphs. Then a simple union is created. This
74#' function can also be used via the \%du\% operator.
75#'
76#' \code{graph.disjont.union} handles graph, vertex and edge attributes.  In
77#' particular, it merges vertex and edge attributes using the basic \code{c()}
78#' function. For graphs that lack some vertex/edge attribute, the corresponding
79#' values in the new graph are set to \code{NA}. Graph attributes are simply
80#' copied to the result. If this would result a name clash, then they are
81#' renamed by adding suffixes: _1, _2, etc.
82#'
83#' Note that if both graphs have vertex names (ie. a \code{name} vertex
84#' attribute), then the concatenated vertex names might be non-unique in the
85#' result. A warning is given if this happens.
86#'
87#' An error is generated if some input graphs are directed and others are
88#' undirected.
89#'
90#' @aliases graph.disjoint.union %du%
91#' @param \dots Graph objects or lists of graph objects.
92#' @param x,y Graph objects.
93#' @return A new graph object.
94#' @author Gabor Csardi \email{csardi.gabor@@gmail.com}
95#' @export
96#' @keywords graphs
97#' @examples
98#'
99#' ## A star and a ring
100#' g1 <- make_star(10, mode="undirected")
101#' V(g1)$name <- letters[1:10]
102#' g2 <- make_ring(10)
103#' V(g2)$name <- letters[11:20]
104#' print_all(g1 %du% g2)
105#' @export
106
107disjoint_union <- function(...) {
108
109  graphs <- unlist(recursive=FALSE, lapply(list(...), function(l) {
110    if (is_igraph(l)) list(l) else l
111  } ))
112  if (!all(sapply(graphs, is_igraph))) {
113    stop("Not a graph object")
114  }
115
116  on.exit( .Call(C_R_igraph_finalizer) )
117  res <- .Call(C_R_igraph_disjoint_union, graphs)
118
119  ## Graph attributes
120  graph.attributes(res) <- rename.attr.if.needed("g", graphs)
121
122  ## Vertex attributes
123  attr <- list()
124  vc <- sapply(graphs, vcount)
125  cumvc <- c(0, cumsum(vc))
126  for (i in seq_along(graphs)) {
127    va <- vertex.attributes(graphs[[i]])
128    exattr <- intersect(names(va), names(attr))   # existing and present
129    noattr <- setdiff(names(attr), names(va))     # existint and missing
130    newattr <- setdiff(names(va), names(attr))    # new
131    for (a in seq_along(exattr)) {
132      attr[[ exattr[a] ]] <- c(attr[[ exattr[a] ]], va[[ exattr[a] ]])
133    }
134    for (a in seq_along(noattr)) {
135      attr[[ noattr[a] ]] <- c(attr[[ noattr[a] ]], rep(NA, vc[i]))
136    }
137    for (a in seq_along(newattr)) {
138      attr[[ newattr[a] ]] <- c(rep(NA, cumvc[i]), va[[ newattr[a] ]])
139    }
140  }
141  vertex.attributes(res) <- attr
142
143  if ("name" %in% names(attr) && any(duplicated(attr$name))) {
144    warning("Duplicate vertex names in disjoint union")
145  }
146
147  ## Edge attributes
148  attr <- list()
149  ec <- sapply(graphs, ecount)
150  cumec <- c(0, cumsum(ec))
151  for (i in seq_along(graphs)) {
152    ea <- edge.attributes(graphs[[i]])
153    exattr <- intersect(names(ea), names(attr))   # existing and present
154    noattr <- setdiff(names(attr), names(ea))     # existint and missing
155    newattr <- setdiff(names(ea), names(attr))    # new
156    for (a in seq_along(exattr)) {
157      attr[[ exattr[a] ]] <- c(attr[[ exattr[a] ]], ea[[ exattr[a] ]])
158    }
159    for (a in seq_along(noattr)) {
160      attr[[ noattr[a] ]] <- c(attr[[ noattr[a] ]], rep(NA, ec[i]))
161    }
162    for (a in seq_along(newattr)) {
163      attr[[ newattr[a] ]] <- c(rep(NA, cumec[i]), ea[[ newattr[a] ]])
164    }
165  }
166  edge.attributes(res) <- attr
167
168  res
169}
170
171#' @export
172#' @rdname disjoint_union
173
174"%du%" <- function(x,y) {
175  disjoint_union(x,y)
176}
177
178.igraph.graph.union.or.intersection <- function(call, ..., byname,
179                                                keep.all.vertices) {
180
181  graphs <- unlist(recursive=FALSE, lapply(list(...), function(l) {
182    if (is_igraph(l)) list(l) else l
183  } ))
184  if (!all(sapply(graphs, is_igraph))) {
185    stop("Not a graph object")
186  }
187  if (byname != "auto" && !is.logical(byname)) {
188    stop("`bynam' must be \"auto\", or logical")
189  }
190  nonamed <- sum(sapply(graphs, is_named))
191  if (byname == "auto") {
192    byname <- all(sapply(graphs, is_named))
193    if (nonamed != 0 && nonamed != length(graphs)) {
194      warning("Some, but not all graphs are named, not using vertex names")
195    }
196  } else if (byname && nonamed != length(graphs)) {
197    stop("Some graphs are not named")
198  }
199
200  edgemaps <- length(unlist(lapply(graphs, edge_attr_names))) != 0
201
202  if (byname) {
203    allnames <- lapply(graphs, vertex_attr, "name")
204    if (keep.all.vertices) {
205      uninames <- unique(unlist(allnames))
206      newgraphs <- lapply(graphs, function(g) {
207        g <- g + setdiff(uninames, V(g)$name)
208        permute(g, match(V(g)$name, uninames))
209      })
210    } else {
211      uninames <- Reduce(intersect, allnames)
212      newgraphs <- lapply(graphs, function(g) {
213        g <- g - setdiff(V(g)$name, uninames)
214        permute(g, match(V(g)$name, uninames))
215      })
216    }
217
218    on.exit( .Call(C_R_igraph_finalizer) )
219    if (call == "union") {
220      res <- .Call(C_R_igraph_union, newgraphs, edgemaps)
221    } else {
222      res <- .Call(C_R_igraph_intersection, newgraphs, edgemaps)
223    }
224    maps <- res$edgemaps
225    res <- res$graph
226
227    ## We might need to rename all attributes
228    graph.attributes(res) <- rename.attr.if.needed("g", newgraphs)
229    vertex.attributes(res) <- rename.attr.if.needed("v", newgraphs,
230                                                    vcount(res),
231                                                    ignore="name")
232    V(res)$name <- uninames
233
234    ## Edges are a bit more difficult, we need a mapping
235    if (edgemaps) {
236      edge.attributes(res) <- rename.attr.if.needed("e", newgraphs,
237                                                    ecount(res),
238                                                    maps=maps)
239    }
240  } else {
241
242    if (!keep.all.vertices) {
243      minsize <- min(sapply(graphs, vcount))
244      graphs <- lapply(graphs, function(g) {
245        vc <- vcount(g)
246        if (vc > minsize) {
247          g <- g - (minsize+1):vc
248        }
249        g
250      })
251    }
252
253    on.exit( .Call(C_R_igraph_finalizer) )
254    if (call == "union") {
255      res <- .Call(C_R_igraph_union, graphs, edgemaps)
256    } else {
257      res <- .Call(C_R_igraph_intersection, graphs, edgemaps)
258    }
259    maps <- res$edgemaps
260    res <- res$graph
261
262    ## We might need to rename all attributes
263    graph.attributes(res) <- rename.attr.if.needed("g", graphs)
264    vertex.attributes(res) <- rename.attr.if.needed("v", graphs,
265                                                    vcount(res))
266
267    ## Edges are a bit more difficult, we need a mapping
268    if (edgemaps) {
269      edge.attributes(res) <- rename.attr.if.needed("e", graphs,
270                                                    ecount(res),
271                                                    maps=maps)
272    }
273  }
274
275  res
276}
277
278#' Union of two or more sets
279#'
280#' This is an S3 generic function. See \code{methods("union")}
281#' for the actual implementations for various S3 classes. Initially
282#' it is implemented for igraph graphs and igraph vertex and edge
283#' sequences. See
284#' \code{\link{union.igraph}}, and
285#' \code{\link{union.igraph.vs}}.
286#'
287#' @param ... Arguments, their number and interpretation depends on
288#' the function that implements \code{union}.
289#' @return Depends on the function that implements this method.
290#'
291#' @export
292
293union <- function(...)
294  UseMethod("union")
295
296#' @method union default
297#' @export
298
299union.default <- function(...) {
300  base::union(...)
301}
302
303#' Union of graphs
304#'
305#' The union of two or more graphs are created. The graphs may have identical
306#' or overlapping vertex sets.
307#'
308#' \code{union} creates the union of two or more graphs.  Edges which are
309#' included in at least one graph will be part of the new graph. This function
310#' can be also used via the \%u\% operator.
311#'
312#' If the \code{byname} argument is \code{TRUE} (or \code{auto} and all graphs
313#' are named), then the operation is performed on symbolic vertex names instead
314#' of the internal numeric vertex ids.
315#'
316#' \code{union} keeps the attributes of all graphs. All graph, vertex and
317#' edge attributes are copied to the result. If an attribute is present in
318#' multiple graphs and would result a name clash, then this attribute is
319#' renamed by adding suffixes: _1, _2, etc.
320#'
321#' The \code{name} vertex attribute is treated specially if the operation is
322#' performed based on symbolic vertex names. In this case \code{name} must be
323#' present in all graphs, and it is not renamed in the result graph.
324#'
325#' An error is generated if some input graphs are directed and others are
326#' undirected.
327#'
328#' @aliases graph.union %u%
329#' @param \dots Graph objects or lists of graph objects.
330#' @param byname A logical scalar, or the character scalar \code{auto}. Whether
331#' to perform the operation based on symbolic vertex names. If it is
332#' \code{auto}, that means \code{TRUE} if all graphs are named and \code{FALSE}
333#' otherwise. A warning is generated if \code{auto} and some (but not all)
334#' graphs are named.
335#' @return A new graph object.
336#' @author Gabor Csardi \email{csardi.gabor@@gmail.com}
337#' @method union igraph
338#' @export
339#' @keywords graphs
340#' @examples
341#'
342#' ## Union of two social networks with overlapping sets of actors
343#' net1 <- graph_from_literal(D-A:B:F:G, A-C-F-A, B-E-G-B, A-B, F-G,
344#'                   H-F:G, H-I-J)
345#' net2 <- graph_from_literal(D-A:F:Y, B-A-X-F-H-Z, F-Y)
346#' print_all(net1 %u% net2)
347
348union.igraph <- function(..., byname="auto") {
349  .igraph.graph.union.or.intersection("union", ..., byname=byname,
350                                      keep.all.vertices=TRUE)
351}
352
353#' @export
354
355"%u%" <- function(x,y) {
356  union(x,y)
357}
358
359#' Intersection of two or more sets
360#'
361#' This is an S3 generic function. See \code{methods("intersection")}
362#' for the actual implementations for various S3 classes. Initially
363#' it is implemented for igraph graphs and igraph vertex and edge
364#' sequences. See
365#' \code{\link{intersection.igraph}}, and
366#' \code{\link{intersection.igraph.vs}}.
367#'
368#' @param ... Arguments, their number and interpretation depends on
369#' the function that implements \code{intersection}.
370#' @return Depends on the function that implements this method.
371#'
372#' @export
373
374intersection <- function(...)
375  UseMethod("intersection")
376
377#' Intersection of graphs
378#'
379#' The intersection of two or more graphs are created.  The graphs may have
380#' identical or overlapping vertex sets.
381#'
382#' \code{intersection} creates the intersection of two or more graphs:
383#' only edges present in all graphs will be included.  The corresponding
384#' operator is \%s\%.
385#'
386#' If the \code{byname} argument is \code{TRUE} (or \code{auto} and all graphs
387#' are named), then the operation is performed on symbolic vertex names instead
388#' of the internal numeric vertex ids.
389#'
390#' \code{intersection} keeps the attributes of all graphs. All graph,
391#' vertex and edge attributes are copied to the result. If an attribute is
392#' present in multiple graphs and would result a name clash, then this
393#' attribute is renamed by adding suffixes: _1, _2, etc.
394#'
395#' The \code{name} vertex attribute is treated specially if the operation is
396#' performed based on symbolic vertex names. In this case \code{name} must be
397#' present in all graphs, and it is not renamed in the result graph.
398#'
399#' An error is generated if some input graphs are directed and others are
400#' undirected.
401#'
402#' @aliases graph.intersection %s%
403#' @param \dots Graph objects or lists of graph objects.
404#' @param byname A logical scalar, or the character scalar \code{auto}. Whether
405#' to perform the operation based on symbolic vertex names. If it is
406#' \code{auto}, that means \code{TRUE} if all graphs are named and \code{FALSE}
407#' otherwise. A warning is generated if \code{auto} and some (but not all)
408#' graphs are named.
409#' @param keep.all.vertices Logical scalar, whether to keep vertices that only
410#' appear in a subset of the input graphs.
411#' @return A new graph object.
412#' @author Gabor Csardi \email{csardi.gabor@@gmail.com}
413#' @method intersection igraph
414#' @export
415#' @keywords graphs
416#' @examples
417#'
418#' ## Common part of two social networks
419#' net1 <- graph_from_literal(D-A:B:F:G, A-C-F-A, B-E-G-B, A-B, F-G,
420#'                   H-F:G, H-I-J)
421#' net2 <- graph_from_literal(D-A:F:Y, B-A-X-F-H-Z, F-Y)
422#' print_all(net1 %s% net2)
423
424intersection.igraph <- function(..., byname="auto",
425                                keep.all.vertices=TRUE) {
426  .igraph.graph.union.or.intersection("intersection", ...,
427                                      byname=byname,
428                                      keep.all.vertices=keep.all.vertices)
429}
430
431#' @export
432
433"%s%" <- function(x,y) {
434  intersection(x,y)
435}
436
437#' Difference of two sets
438#'
439#' This is an S3 generic function. See \code{methods("difference")}
440#' for the actual implementations for various S3 classes. Initially
441#' it is implemented for igraph graphs (difference of edges in two graphs),
442#' and igraph vertex and edge sequences. See
443#' \code{\link{difference.igraph}}, and
444#' \code{\link{difference.igraph.vs}}.
445#'
446#' @param ... Arguments, their number and interpretation depends on
447#' the function that implements \code{difference}.
448#' @return Depends on the function that implements this method.
449#'
450#' @export
451
452difference <- function(...)
453  UseMethod("difference")
454
455
456#' Difference of graphs
457#'
458#' The difference of two graphs are created.
459#'
460#' \code{difference} creates the difference of two graphs. Only edges
461#' present in the first graph but not in the second will be be included in the
462#' new graph. The corresponding operator is \%m\%.
463#'
464#' If the \code{byname} argument is \code{TRUE} (or \code{auto} and the graphs
465#' are all named), then the operation is performed based on symbolic vertex
466#' names. Otherwise numeric vertex ids are used.
467#'
468#' \code{difference} keeps all attributes (graph, vertex and edge) of the
469#' first graph.
470#'
471#' Note that \code{big} and \code{small} must both be directed or both be
472#' undirected, otherwise an error message is given.
473#'
474#' @aliases graph.difference %m%
475#' @param big The left hand side argument of the minus operator. A directed or
476#' undirected graph.
477#' @param small The right hand side argument of the minus operator. A directed
478#' ot undirected graph.
479#' @param byname A logical scalar, or the character scalar \code{auto}. Whether
480#' to perform the operation based on symbolic vertex names. If it is
481#' \code{auto}, that means \code{TRUE} if both graphs are named and
482#' \code{FALSE} otherwise. A warning is generated if \code{auto} and one graph,
483#' but not both graphs are named.
484#' @param ... Ignored, included for S3 compatibility.
485#' @return A new graph object.
486#' @author Gabor Csardi \email{csardi.gabor@@gmail.com}
487#' @method difference igraph
488#' @export
489#' @keywords graphs
490#' @examples
491#'
492#' ## Create a wheel graph
493#' wheel <- union(make_ring(10),
494#'                      make_star(11, center=11, mode="undirected"))
495#' V(wheel)$name <- letters[seq_len(vcount(wheel))]
496#'
497#' ## Subtract a star graph from it
498#' sstar <- make_star(6, center=6, mode="undirected")
499#' V(sstar)$name <- letters[c(1,3,5,7,9,11)]
500#' G <- wheel %m% sstar
501#' print_all(G)
502#' plot(G, layout=layout_nicely(wheel))
503
504difference.igraph <- function(big, small, byname="auto", ...) {
505
506  if (!is_igraph(big) || !is_igraph(small)) {
507    stop("argument is not a graph")
508  }
509  if (byname != "auto" && !is.logical(byname)) {
510    stop("`bynam' must be \"auto\", or logical")
511  }
512  nonamed <- is_named(big) + is_named(small)
513  if (byname == "auto") {
514    byname <- nonamed == 2
515    if (nonamed == 1) {
516      warning("One, but not both graphs are named, not using vertex names")
517    }
518  } else if (byname && nonamed != 2) {
519    stop("Some graphs are not named")
520  }
521
522  if (byname) {
523    bnames <- V(big)$name
524    snames <- V(small)$name
525    if (any(! snames %in% bnames)) {
526      small <- small - setdiff(snames, bnames)
527      snames <- V(small)$name
528    }
529    perm <- match(bnames, snames)
530    if (any(is.na(perm))) {
531      perm[is.na(perm)] <- seq(from=vcount(small)+1, to=vcount(big))
532    }
533    big <- permute(big, perm)
534
535    on.exit(.Call(C_R_igraph_finalizer))
536    res <- .Call(C_R_igraph_difference, big, small)
537    permute(res, match(V(res)$name, bnames))
538
539  } else {
540    on.exit( .Call(C_R_igraph_finalizer) )
541    .Call(C_R_igraph_difference, big, small)
542  }
543}
544
545#' @export
546
547"%m%" <- function(x,y) {
548  difference(x,y)
549}
550
551
552
553#' Complementer of a graph
554#'
555#' A complementer graph contains all edges that were not present in the input
556#' graph.
557#'
558#' \code{complementer} creates the complementer of a graph. Only edges
559#' which are \emph{not} present in the original graph will be included in the
560#' new graph.
561#'
562#' \code{complementer} keeps graph and vertex attriubutes, edge
563#' attributes are lost.
564#'
565#' @aliases graph.complementer
566#' @param graph The input graph, can be directed or undirected.
567#' @param loops Logical constant, whether to generate loop edges.
568#' @return A new graph object.
569#' @author Gabor Csardi \email{csardi.gabor@@gmail.com}
570#' @export
571#' @keywords graphs
572#' @examples
573#'
574#' ## Complementer of a ring
575#' g <- make_ring(10)
576#' complementer(g)
577#'
578#' ## A graph and its complementer give together the full graph
579#' g <- make_ring(10)
580#' gc <- complementer(g)
581#' gu <- union(g, gc)
582#' gu
583#' graph.isomorphic(gu, make_full_graph(vcount(g)))
584#'
585complementer <- function(graph, loops=FALSE) {
586
587  if (!is_igraph(graph)) {
588    stop("Not a graph object")
589  }
590  on.exit( .Call(C_R_igraph_finalizer) )
591  .Call(C_R_igraph_complementer, graph, as.logical(loops))
592}
593
594
595
596#' Compose two graphs as binary relations
597#'
598#' Relational composition of two graph.
599#'
600#' \code{compose} creates the relational composition of two graphs. The
601#' new graph will contain an (a,b) edge only if there is a vertex c, such that
602#' edge (a,c) is included in the first graph and (c,b) is included in the
603#' second graph. The corresponding operator is \%c\%.
604#'
605#' The function gives an error if one of the input graphs is directed and the
606#' other is undirected.
607#'
608#' If the \code{byname} argument is \code{TRUE} (or \code{auto} and the graphs
609#' are all named), then the operation is performed based on symbolic vertex
610#' names. Otherwise numeric vertex ids are used.
611#'
612#' \code{compose} keeps the attributes of both graphs. All graph, vertex
613#' and edge attributes are copied to the result. If an attribute is present in
614#' multiple graphs and would result a name clash, then this attribute is
615#' renamed by adding suffixes: _1, _2, etc.
616#'
617#' The \code{name} vertex attribute is treated specially if the operation is
618#' performed based on symbolic vertex names. In this case \code{name} must be
619#' present in both graphs, and it is not renamed in the result graph.
620#'
621#' Note that an edge in the result graph corresponds to two edges in the input,
622#' one in the first graph, one in the second. This mapping is not injective and
623#' several edges in the result might correspond to the same edge in the first
624#' (and/or the second) graph. The edge attributes in the result graph are
625#' updated accordingly.
626#'
627#' Also note that the function may generate multigraphs, if there are more than
628#' one way to find edges (a,b) in g1 and (b,c) in g2 for an edge (a,c) in the
629#' result. See \code{\link{simplify}} if you want to get rid of the multiple
630#' edges.
631#'
632#' The function may create loop edges, if edges (a,b) and (b,a) are present in
633#' g1 and g2, respectively, then (a,a) is included in the result. See
634#' \code{\link{simplify}} if you want to get rid of the self-loops.
635#'
636#' @aliases graph.compose %c%
637#' @param g1 The first input graph.
638#' @param g2 The second input graph.
639#' @param byname A logical scalar, or the character scalar \code{auto}. Whether
640#' to perform the operation based on symbolic vertex names. If it is
641#' \code{auto}, that means \code{TRUE} if both graphs are named and
642#' \code{FALSE} otherwise. A warning is generated if \code{auto} and one graph,
643#' but not both graphs are named.
644#' @return A new graph object.
645#' @author Gabor Csardi \email{csardi.gabor@@gmail.com}
646#' @export
647#' @keywords graphs
648#' @examples
649#'
650#' g1 <- make_ring(10)
651#' g2 <- make_star(10, mode="undirected")
652#' gc <- compose(g1, g2)
653#' print_all(gc)
654#' print_all(simplify(gc))
655#'
656compose <- function(g1, g2, byname="auto") {
657
658  if (!is_igraph(g1) || !is_igraph(g2)) {
659    stop("Not a graph object")
660  }
661
662  if (byname != "auto" && !is.logical(byname)) {
663    stop("`byname' must be \"auto\", or logical")
664  }
665  nonamed <- is_named(g1) + is_named(g2)
666  if (byname == "auto") {
667    byname <- nonamed == 2
668    if (nonamed == 1) {
669      warning("One, but not both graphs are named, not using vertex names")
670    }
671  } else if (byname && nonamed != 2) {
672    stop("Some graphs are not named")
673  }
674
675  if (byname) {
676    uninames <- unique(c(V(g1)$name, V(g2)$name))
677    if (vcount(g1) < length(uninames)) {
678      g1 <- g1 + setdiff(uninames, V(g1)$name)
679    }
680    if (vcount(g2) < length(uninames)) {
681      g2 <- g2 + setdiff(uninames, V(g2)$name)
682    }
683    if (any(uninames != V(g1)$name)) {
684      g1 <- permute(g1, match(V(g1)$name, uninames))
685    }
686    if (any(uninames != V(g2)$name)) {
687      g2 <- permute(g2, match(V(g2)$name, uninames))
688    }
689  }
690
691  edgemaps <- (length(edge_attr_names(g1)) != 0 ||
692               length(edge_attr_names(g2)) != 0)
693
694  on.exit( .Call(C_R_igraph_finalizer) )
695  res <- .Call(C_R_igraph_compose, g1, g2, edgemaps)
696  maps <- list(res$edge_map1, res$edge_map2)
697  res <- res$graph
698
699  ## We might need to rename all attributes
700  graphs <- list(g1, g2)
701  graph.attributes(res) <- rename.attr.if.needed("g", graphs)
702
703  if (byname) {
704    vertex.attributes(res) <-
705      rename.attr.if.needed("v", graphs, vcount(res), ignore="name")
706    V(res)$name <- uninames
707  } else {
708    vertex.attributes(res) <- rename.attr.if.needed("v", graphs,
709                                                    vcount(res))
710  }
711
712  if (edgemaps) {
713    edge.attributes(res) <- rename.attr.if.needed("e", graphs, ecount(res),
714                                                  maps2=maps)
715  }
716
717  res
718}
719
720#' @export
721
722"%c%" <- function(x,y) {
723  compose(x,y)
724}
725
726#' Helper function for adding and deleting edges
727#'
728#' This is a helper function that simplifies adding and deleting
729#' edges to/from graphs.
730#'
731#' \code{edges} is an alias for \code{edge}.
732#'
733#' @details
734#' When adding edges via \code{+}, all unnamed arguments of
735#' \code{edge} (or \code{edges}) are concatenated, and then passed to
736#' \code{\link{add_edges}}. They are interpreted as pairs of vertex ids,
737#' and an edge will added between each pair. Named arguments will be
738#' used as edge attributes for the new edges.
739#'
740#' When deleting edges via \code{-}, all arguments of \code{edge} (or
741#' \code{edges}) are concatenated via \code{c()} and passed to
742#' \code{\link{delete_edges}}.
743#'
744#' @param ... See details below.
745#' @return A special object that can be used with together with
746#'   igraph graphs and the plus and minus operators.
747#'
748#' @family functions for manipulating graph structure
749#'
750#' @export
751#' @examples
752#' g <- make_ring(10) %>%
753#'   set_edge_attr("color", value = "red")
754#'
755#' g <- g + edge(1, 5, color = "green") +
756#'   edge(2, 6, color = "blue") -
757#'   edge("8|9")
758#'
759#' E(g)[[]]
760#'
761#' g %>%
762#'   add_layout_(in_circle()) %>%
763#'   plot()
764#'
765#' g <- make_ring(10) + edges(1:10)
766#' plot(g)
767
768edge <- function(...) {
769  structure(list(...), class="igraph.edge")
770}
771
772#' @export
773#' @rdname edge
774
775edges <- edge
776
777#' Helper function for adding and deleting vertices
778#'
779#' This is a helper function that simplifies adding and deleting
780#' vertices to/from graphs.
781#'
782#' \code{vertices} is an alias for \code{vertex}.
783#'
784#' @details
785#' When adding vertices via \code{+}, all unnamed arguments are interpreted
786#' as vertex names of the new vertices. Named arguments are interpreted as
787#' vertex attributes for the new vertices.
788#'
789#' When deleting vertices via \code{-}, all arguments of \code{vertex} (or
790#' \code{vertices}) are concatenated via \code{c()} and passed to
791#' \code{\link{delete_vertices}}.
792#'
793#' @param ... See details below.
794#' @return A special object that can be used with together with
795#'   igraph graphs and the plus and minus operators.
796#'
797#' @family functions for manipulating graph structure
798#'
799#' @export
800#' @examples
801#' g <- make_(ring(10), with_vertex_(name = LETTERS[1:10])) +
802#'   vertices('X', 'Y')
803#' g
804#' plot(g)
805
806vertex <- function(...) {
807  structure(list(...), class="igraph.vertex")
808}
809
810#' @export
811#' @rdname vertex
812
813vertices <- vertex
814
815#' Helper function to add or delete edges along a path
816#'
817#' This function can be used to add or delete edges that form a path.
818#'
819#' @details
820#' When adding edges via \code{+}, all unnamed arguments are
821#' concatenated, and each element of a final vector is interpreted
822#' as a vertex in the graph. For a vector of length \eqn{n+1}, \eqn{n}
823#' edges are then added, from vertex 1 to vertex 2, from vertex 2 to vertex
824#' 3, etc. Named arguments will be used as edge attributes for the new
825#' edges.
826#'
827#' When deleting edges, all attributes are concatenated and then passed
828#' to \code{\link{delete_edges}}.
829#'
830#' @param ... See details below.
831#' @return A special object that can be used together with igraph
832#'   graphs and the plus and minus operators.
833#'
834#' @family functions for manipulating graph structure
835#'
836#' @export
837#' @examples
838#' # Create a (directed) wheel
839#' g <- make_star(11, center = 1) + path(2:11, 2)
840#' plot(g)
841#'
842#' g <- make_empty_graph(directed = FALSE, n = 10) %>%
843#'   set_vertex_attr("name", value = letters[1:10])
844#'
845#' g2 <- g + path("a", "b", "c", "d")
846#' plot(g2)
847#'
848#' g3 <- g2 + path("e", "f", "g", weight=1:2, color="red")
849#' E(g3)[[]]
850#'
851#' g4 <- g3 + path(c("f", "c", "j", "d"), width=1:3, color="green")
852#' E(g4)[[]]
853
854path <- function(...) {
855  structure(list(...), class="igraph.path")
856}
857
858#' Add vertices, edges or another graph to a graph
859#'
860#' @details
861#'   The plus operator can be used to add vertices or edges to graph.
862#'   The actual operation that is performed depends on the type of the
863#'   right hand side argument.
864#'   \itemize{
865#'   \item If is is another igraph graph object and they are both
866#'     named graphs, then the union of the two graphs are calculated,
867#'     see \code{\link{union}}.
868#'   \item If it is another igraph graph object, but either of the two
869#'     are not named, then the disjoint union of
870#'     the two graphs is calculated, see \code{\link{disjoint_union}}.
871#'   \item If it is a numeric scalar, then the specified number of vertices
872#'     are added to the graph.
873#'   \item If it is a character scalar or vector, then it is interpreted as
874#'     the names of the vertices to add to the graph.
875#'   \item If it is an object created with the \code{\link{vertex}} or
876#'     \code{\link{vertices}} function, then new vertices are added to the
877#'     graph. This form is appropriate when one wants to add some vertex
878#'     attributes as well. The operands of the \code{vertices} function
879#'     specifies the number of vertices to add and their attributes as
880#'     well.
881#'
882#'     The unnamed arguments of \code{vertices} are concatenated and
883#'     used as the \sQuote{\code{name}} vertex attribute (i.e. vertex
884#'     names), the named arguments will be added as additional vertex
885#'     attributes. Examples: \preformatted{  g <- g +
886#'         vertex(shape="circle", color= "red")
887#'   g <- g + vertex("foo", color="blue")
888#'   g <- g + vertex("bar", "foobar")
889#'   g <- g + vertices("bar2", "foobar2", color=1:2, shape="rectangle")}
890#'
891#'     \code{vertex} is just an alias to \code{vertices}, and it is
892#'     provided for readability. The user should use it if a single vertex
893#'     is added to the graph.
894#'
895#'   \item If it is an object created with the \code{\link{edge}} or
896#'     \code{\link{edges}} function, then new edges will be added to the
897#'     graph. The new edges and possibly their attributes can be specified as
898#'     the arguments of the \code{edges} function.
899#'
900#'     The unnamed arguments of \code{edges} are concatenated and used
901#'     as vertex ids of the end points of the new edges. The named
902#'     arguments will be added as edge attributes.
903#'
904#'     Examples: \preformatted{  g <- make_empty_graph() +
905#'          vertices(letters[1:10]) +
906#'          vertices("foo", "bar", "bar2", "foobar2")
907#'   g <- g + edge("a", "b")
908#'   g <- g + edges("foo", "bar", "bar2", "foobar2")
909#'   g <- g + edges(c("bar", "foo", "foobar2", "bar2"), color="red", weight=1:2)}
910#'     See more examples below.
911#'
912#'     \code{edge} is just an alias to \code{edges} and it is provided
913#'     for readability. The user should use it if a single edge is added to
914#'     the graph.
915#'
916#'   \item If it is an object created with the \code{\link{path}} function, then
917#'     new edges that form a path are added. The edges and possibly their
918#'     attributes are specified as the arguments to the \code{path}
919#'     function. The non-named arguments are concatenated and interpreted
920#'     as the vertex ids along the path. The remaining arguments are added
921#'     as edge attributes.
922#'
923#'     Examples: \preformatted{  g <- make_empty_graph() + vertices(letters[1:10])
924#'   g <- g + path("a", "b", "c", "d")
925#'   g <- g + path("e", "f", "g", weight=1:2, color="red")
926#'   g <- g + path(c("f", "c", "j", "d"), width=1:3, color="green")}
927#'   }
928#'
929#'   It is important to note that, although the plus operator is
930#'   commutative, i.e. is possible to write \preformatted{  graph <- "foo" + make_empty_graph()}
931#'   it is not associative, e.g. \preformatted{  graph <- "foo" + "bar" + make_empty_graph()}
932#'   results a syntax error, unless parentheses are used: \preformatted{  graph <- "foo" + ( "bar" + make_empty_graph() )}
933#'   For clarity, we suggest to always put the graph object on the left
934#'   hand side of the operator: \preformatted{  graph <- make_empty_graph() + "foo" + "bar"}
935#'
936#' @param e1 First argument, probably an igraph graph, but see details
937#'    below.
938#' @param e2 Second argument, see details below.
939#'
940#' @family functions for manipulating graph structure
941#'
942#' @method + igraph
943#' @export
944#' @examples
945#' # 10 vertices named a,b,c,... and no edges
946#' g <- make_empty_graph() + vertices(letters[1:10])
947#'
948#' # Add edges to make it a ring
949#' g <- g + path(letters[1:10], letters[1], color = "grey")
950#'
951#' # Add some extra random edges
952#' g <- g + edges(sample(V(g), 10, replace = TRUE), color = "red")
953#' g$layout <- layout_in_circle
954#' plot(g)
955
956`+.igraph` <- function(e1, e2) {
957  if (!is_igraph(e1) && is_igraph(e2)) {
958    tmp <- e1
959    e1 <- e2
960    e2 <- tmp
961  }
962  if (is_igraph(e2) && is_named(e1) && is_named(e2)) {
963    ## Union of graphs
964    res <- union(e1, e2)
965  } else if (is_igraph(e2)) {
966    ## Disjoint union of graphs
967    res <- disjoint_union(e1,e2)
968
969  } else if ("igraph.edge" %in% class(e2)) {
970    ## Adding edges, possibly with attributes
971    ## Non-named arguments define the edges
972    if (is.null(names(e2))) {
973      toadd <- unlist(e2, recursive=FALSE)
974      attr <- list()
975    } else {
976      toadd <- unlist(e2[names(e2)==""])
977      attr <- e2[names(e2)!=""]
978    }
979    res <- add_edges(e1, as.igraph.vs(e1, toadd), attr=attr)
980
981  } else if ("igraph.vertex" %in% class(e2)) {
982    ## Adding vertices, possibly with attributes
983    ## If there is a single unnamed argument, that contains the vertex names
984    wn <- which(names(e2)=="")
985    if (length(wn)==1) {
986      names(e2)[wn] <- "name"
987    } else if (is.null(names(e2))) {
988    ## No names at all, everything is a vertex name
989      e2 <- list(name=unlist(e2, recursive=FALSE))
990    } else if (length(wn)==0) {
991    ## If there are no non-named arguments, we are fine
992    } else {
993    ## Otherwise, all unnamed arguments are collected and used as
994    ## vertex names
995      nn <- unlist(e2[wn], recursive=FALSE)
996      e2 <- c(list(name=nn), e2[names(e2)!=""])
997    }
998    la <- unique(sapply(e2, length))
999    res <- add_vertices(e1, la, attr=e2)
1000
1001  } else if ("igraph.path" %in% class(e2)) {
1002    ## Adding edges along a path, possibly with attributes
1003    ## Non-named arguments define the edges
1004    if (is.null(names(e2))) {
1005      toadd <- unlist(e2, recursive=FALSE)
1006      attr <- list()
1007    } else {
1008      toadd <- unlist(e2[names(e2)==""])
1009      attr <- e2[names(e2)!=""]
1010    }
1011    toadd <- as.igraph.vs(e1, toadd)
1012    lt <- length(toadd)
1013    if (lt >= 2) {
1014      toadd <- c(toadd[1], rep(toadd[2:(lt-1)], each=2), toadd[lt])
1015      res <- add_edges(e1, toadd, attr=attr)
1016    } else {
1017      res <- e1
1018    }
1019
1020  } else if (is.numeric(e2) && length(e2)==1) {
1021    ## Adding some isolate vertices
1022    res <- add_vertices(e1, e2)
1023
1024  } else if (is.character(e2)) {
1025    ## Adding named vertices
1026    res <- add_vertices(e1, length(e2), name=e2)
1027
1028  } else {
1029    stop("Cannot add unknown type to igraph graph")
1030  }
1031  res
1032}
1033
1034#' Delete vertices or edges from a graph
1035#'
1036#' @details
1037#' The minus operator (\sQuote{\code{-}}) can be used to remove vertices
1038#' or edges from the graph. The operation performed is selected based on
1039#' the type of the right hand side argument:
1040#' \itemize{
1041#' \item If it is an igraph graph object, then the difference of the
1042#'   two graphs is calculated, see \code{\link{difference}}.
1043#' \item If it is a numeric or character vector, then it is interpreted
1044#'   as a vector of vertex ids and the specified vertices will be
1045#'   deleted from the graph. Example: \preformatted{  g <- make_ring(10)
1046#' V(g)$name <- letters[1:10]
1047#' g <- g - c("a", "b")}
1048#' \item If \code{e2} is a vertex sequence (e.g. created by the
1049#'   \code{\link{V}} function), then these vertices will be deleted from
1050#'   the graph.
1051#' \item If it is an edge sequence (e.g. created by the \code{\link{E}}
1052#'   function), then these edges will be deleted from the graph.
1053#' \item If it is an object created with the \code{\link{vertex}} (or the
1054#'   \code{\link{vertices}}) function, then all arguments of \code{\link{vertices}} are
1055#'   concatenated and the result is interpreted as a vector of vertex
1056#'   ids. These vertices will be removed from the graph.
1057#' \item If it is an object created with the \code{\link{edge}} (or the
1058#'   \code{\link{edges}}) function, then all arguments of \code{\link{edges}} are
1059#'   concatenated and then interpreted as edges to be removed from the
1060#'   graph.
1061#'   Example: \preformatted{  g <- make_ring(10)
1062#' V(g)$name <- letters[1:10]
1063#' E(g)$name <- LETTERS[1:10]
1064#' g <- g - edge("e|f")
1065#' g <- g - edge("H")}
1066#' \item If it is an object created with the \code{\link{path}} function,
1067#'   then all \code{\link{path}} arguments are concatenated and then interpreted
1068#'   as a path along which edges will be removed from the graph.
1069#'   Example: \preformatted{  g <- make_ring(10)
1070#' V(g)$name <- letters[1:10]
1071#' g <- g - path("a", "b", "c", "d")}
1072#' }
1073#'
1074#' @param e1 Left argument, see details below.
1075#' @param e2 Right argument, see details below.
1076#' @return An igraph graph.
1077#'
1078#' @family functions for manipulating graph structure
1079#' @name igraph-minus
1080#'
1081#' @method - igraph
1082#' @export
1083
1084`-.igraph` <- function(e1, e2) {
1085  if (missing(e2)) {
1086    stop("Non-numeric argument to negation operator")
1087  }
1088  if (is_igraph(e2)) {
1089    res <- difference(e1, e2)
1090  } else if ("igraph.vertex" %in% class(e2)) {
1091    res <- delete_vertices(e1, unlist(e2, recursive=FALSE))
1092  } else if ("igraph.edge" %in% class(e2)) {
1093    res <- delete_edges(e1, unlist(e2, recursive=FALSE))
1094  } else if ("igraph.path" %in% class(e2)) {
1095    todel <- unlist(e2, recursive=FALSE)
1096    lt <- length(todel)
1097    if (lt >= 2) {
1098      todel <- paste(todel[-lt], todel[-1], sep="|")
1099      res <- delete_edges(e1, todel)
1100    } else {
1101      res <- e1
1102    }
1103  } else if ("igraph.vs" %in% class(e2)) {
1104    res <- delete_vertices(e1, e2)
1105  } else if ("igraph.es" %in% class(e2)) {
1106    res <- delete_edges(e1, e2)
1107  } else if (is.numeric(e2) || is.character(e2)) {
1108    res <- delete_vertices(e1, e2)
1109  } else {
1110    stop("Cannot substract unknown type from igraph graph")
1111  }
1112  res
1113}
1114
1115#' Replicate a graph multiple times
1116#'
1117#' The new graph will contain the input graph the given number
1118#' of times, as unconnected components.
1119#'
1120#' @param x The input graph.
1121#' @param n Number of times to replicate it.
1122#' @param mark Whether to mark the vertices with a \code{which} attribute,
1123#'   an integer number denoting which replication the vertex is coming
1124#'   from.
1125#' @param ... Additional arguments to satisfy S3 requirements,
1126#'   currently ignored.
1127#'
1128#' @method rep igraph
1129#' @export
1130#'
1131#' @examples
1132#' rings <- make_ring(5) * 5
1133
1134rep.igraph <- function(x, n, mark = TRUE, ...) {
1135
1136  if (n < 0) stop("Number of replications must be positive")
1137
1138  res <- do_call(disjoint_union, .args =
1139                   replicate(n, x, simplify = FALSE))
1140
1141  if (mark) V(res)$which <- rep(seq_len(n), each = gorder(x))
1142
1143  res
1144}
1145
1146#' @rdname rep.igraph
1147#' @method * igraph
1148#' @export
1149
1150`*.igraph` <- function(x, n) {
1151
1152  if (!is_igraph(x) && is_igraph(n)) {
1153    tmp <- x
1154    x <- n
1155    n <- tmp
1156  }
1157
1158  if (is.numeric(n) && length(n) == 1) {
1159    rep.igraph(x, n)
1160
1161  } else {
1162    stop("Cannot multiply igraph graph with this type")
1163  }
1164}
1165