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