1
2## IGraph library.
3## Copyright (C) 2010-2012  Gabor Csardi <csardi.gabor@gmail.com>
4## 334 Harvard street, Cambridge, MA 02139 USA
5
6## This program is free software; you can redistribute it and/or modify
7## it under the terms of the GNU General Public License as published by
8## the Free Software Foundation; either version 2 of the License, or
9## (at your option) any later version.
10
11## This program is distributed in the hope that it will be useful,
12## but WITHOUT ANY WARRANTY; without even the implied warranty of
13## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14## GNU General Public License for more details.
15
16## You should have received a copy of the GNU General Public License
17## along with this program; if not, write to the Free Software
18## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
19## 02110-1301 USA
20
21# Indexing of igraph graphs.
22#
23# Goals:
24# 1. flexible graph manipulation
25# 2. to be as close to the usual matrix and adjacency list semantics,
26#    as possible
27# 3. simple
28# 4. fast
29# 5. orthogonal
30#
31# Rules:
32# - [ is about the existence of the edges.
33# - [ can be used for weights as well, if the graph is weighted.
34# - [[ is about adjacent vertices, and essentially works as an
35#   adjacency list.
36#
37# Use cases:
38# - G[1,2]      is there an edge from vertex 1 to vertex 2?
39# - G[1,1:3]    are there edges from vertex 1 to vertices 1:3?
40# - G[1:2,1:3]  are there adges from vertices 1:2 to vertices 1:3?
41#               this returns a (possibly sparse) matrix.
42# - G[degree(G)==0,1:4]
43#               logical vectors work
44# - G[1,-1]     negative indices work
45#
46# - G[[1,]]     adjacent vertices of 1
47# - G[[,1]]     adjacent predecessors of 1
48# - G[[degree(G),]]
49#               logical vectors work
50# - G[[-1,]]    negative indices work
51#
52# - G[1,2,attr="value"]
53#               query an edge attribute
54# - G[1:3,2,eid=TRUE]
55#               create an edge sequence
56
57
58#' Query and manipulate a graph as it were an adjacency matrix
59#'
60#' @details
61#' The single bracket indexes the (possibly weighted) adjacency matrix of
62#' the graph. Here is what you can do with it:
63#'
64#' \enumerate{
65#' \item Check whether there is an edge between two vertices (\eqn{v}
66#'   and \eqn{w}) in the graph: \preformatted{  graph[v, w]}
67#'    A numeric scalar is returned, one if the edge exists, zero
68#'     otherwise.
69#'   \item Extract the (sparse) adjacency matrix of the graph, or part of
70#'     it: \preformatted{  graph[]
71#' graph[1:3,5:6]
72#' graph[c(1,3,5),]}
73#'     The first variants returns the full adjacency matrix, the other
74#'     two return part of it.
75#'   \item The \code{from} and \code{to} arguments can be used to check
76#'     the existence of many edges. In this case, both \code{from} and
77#'     \code{to} must be present and they must have the same length. They
78#'     must contain vertex ids or names. A numeric vector is returned, of
79#'     the same length as \code{from} and \code{to}, it contains ones
80#'     for existing edges edges and zeros for non-existing ones.
81#'     Example: \preformatted{  graph[from=1:3, to=c(2,3,5)]}.
82#'   \item For weighted graphs, the \code{[} operator returns the edge
83#'     weights. For non-esistent edges zero weights are returned. Other
84#'     edge attributes can be queried as well, by giving the \code{attr}
85#'     argument.
86#'   \item Querying edge ids instead of the existance of edges or edge
87#'     attributes. E.g. \preformatted{  graph[1, 2, edges=TRUE]}
88#'     returns the id of the edge between vertices 1 and 2, or zero if
89#'     there is no such edge.
90#'   \item Adding one or more edges to a graph. For this the element(s) of
91#'     the imaginary adjacency matrix must be set to a non-zero numeric
92#'     value (or \code{TRUE}): \preformatted{  graph[1, 2] <- 1
93#' graph[1:3,1] <- 1
94#' graph[from=1:3, to=c(2,3,5)] <- TRUE}
95#'     This does not affect edges that are already present in the graph,
96#'     i.e. no multiple edges are created.
97#'   \item Adding weighted edges to a graph. The \code{attr} argument
98#'     contains the name of the edge attribute to set, so it does not
99#'     have to be \sQuote{weight}: \preformatted{  graph[1, 2, attr="weight"]<- 5
100#' graph[from=1:3, to=c(2,3,5)] <- c(1,-1,4)}
101#'     If an edge is already present in the network, then only its
102#'     weights or other attribute are updated. If the graph is already
103#'     weighted, then the \code{attr="weight"} setting is implicit, and
104#'     one does not need to give it explicitly.
105#'   \item Deleting edges. The replacement syntax allow the deletion of
106#'     edges, by specifying \code{FALSE} or \code{NULL} as the
107#'     replacement value: \preformatted{  graph[v, w] <- FALSE}
108#'     removes the edge from vertex \eqn{v} to vertex \eqn{w}.
109#'     As this can be used to delete edges between two sets of vertices,
110#'     either pairwise: \preformatted{  graph[from=v, to=w] <- FALSE}
111#'     or not: \preformatted{  graph[v, w] <- FALSE }
112#'     if \eqn{v} and \eqn{w} are vectors of edge ids or names.
113#' }
114#'
115#' \sQuote{\code{[}} allows logical indices and negative indices as well,
116#' with the usual R semantics. E.g. \preformatted{  graph[degree(graph)==0, 1] <- 1}
117#' adds an edge from every isolate vertex to vertex one,
118#' and \preformatted{  G <- make_empty_graph(10)
119#' G[-1,1] <- TRUE}
120#'  creates a star graph.
121#'
122#' Of course, the indexing operators support vertex names,
123#' so instead of a numeric vertex id a vertex can also be given to
124#' \sQuote{\code{[}} and \sQuote{\code{[[}}.
125#'
126#' @param x The graph.
127#' @param i Index. Vertex ids or names or logical vectors. See details
128#'   below.
129#' @param j Index. Vertex ids or names or logical vectors. See details
130#'   below.
131#' @param ... Currently ignored.
132#' @param from A numeric or character vector giving vertex ids or
133#'   names. Together with the \code{to} argument, it can be used to
134#'   query/set a sequence of edges. See details below. This argument cannot
135#'   be present together with any of the \code{i} and \code{j} arguments
136#'   and if it is present, then the \code{to} argument must be present as
137#'   well.
138#' @param to A numeric or character vector giving vertex ids or
139#'   names. Together with the \code{from} argument, it can be used to
140#'   query/set a sequence of edges. See details below. This argument cannot
141#'   be present together with any of the \code{i} and \code{j} arguments
142#'   and if it is present, then the \code{from} argument must be present as
143#'   well.
144#' @param sparse Logical scalar, whether to return sparse matrices.
145#' @param edges Logical scalar, whether to return edge ids.
146#' @param drop Ignored.
147#' @param attr If not \code{NULL}, then it should be the name of an edge
148#'   attribute. This attribute is queried and returned.
149#' @return A scalar or matrix. See details below.
150#'
151#' @family structural queries
152#'
153#' @method [ igraph
154#' @export
155
156`[.igraph` <- function(x, i, j, ..., from, to,
157                       sparse=igraph_opt("sparsematrices"),
158                       edges=FALSE, drop=TRUE,
159                       attr=if (is_weighted(x)) "weight" else NULL) {
160  ## TODO: make it faster, don't need the whole matrix usually
161
162  ################################################################
163  ## Argument checks
164  if ((!missing(from) || !missing(to)) &&
165      (!missing(i)    || !missing(j))) {
166    stop("Cannot give 'from'/'to' together with regular indices")
167  }
168  if ((!missing(from) &&  missing(to)) ||
169      ( missing(from) && !missing(to))) {
170    stop("Cannot give 'from'/'to' without the other")
171  }
172  if (!missing(from)) {
173    if ((!is.numeric(from) && !is.character(from)) || any(is.na(from))) {
174      stop("'from' must be a numeric or character vector without NAs")
175    }
176    if ((!is.numeric(to) && !is.character(to)) || any(is.na(to))) {
177      stop("'to' must be a numeric or character vector without NAs")
178    }
179    if (length(from) != length(to)) {
180      stop("'from' and 'to' must have the same length")
181    }
182  }
183
184  ##################################################################
185
186  if (!missing(from)) {
187    res <- get.edge.ids(x, rbind(from, to), error=FALSE)
188    if (edges) {
189      ## nop
190    } else if (!is.null(attr)) {
191      if (any(res!=0)) {
192        res[res!=0] <- edge_attr(x, attr, res[res!=0])
193      }
194    } else {
195      res <- as.logical(res)+0
196    }
197    res
198  } else if (missing(i) && missing(j)) {
199    as_adj(x, sparse=sparse, attr=attr, edges=edges)
200  } else if (missing(j)) {
201    as_adj(x, sparse=sparse, attr=attr, edges=edges)[i,,drop=drop]
202  } else if (missing(i)) {
203    as_adj(x, sparse=sparse, attr=attr, edges=edges)[,j,drop=drop]
204  } else {
205    as_adj(x, sparse=sparse, attr=attr, edges=edges)[i,j,drop=drop]
206  }
207}
208
209#' Query and manipulate a graph as it were an adjacency list
210#'
211#' @details
212#' The double bracket operator indexes the (imaginary) adjacency list
213#' of the graph. This can used for the following operations:
214#' \enumerate{
215#'   \item Querying the adjacent vertices for one or more
216#'     vertices: \preformatted{  graph[[1:3,]]
217#' graph[[,1:3]]}
218#'     The first form gives the successors, the second the predecessors
219#'     or the 1:3 vertices. (For undirected graphs they are equivalent.)
220#'   \item Querying the incident edges for one or more vertices,
221#'     if the \code{edges} argument is set to
222#'     \code{TRUE}: \preformatted{  graph[[1:3, , edges=TRUE]]
223#' graph[[, 1:3, edges=TRUE]]}
224#'   \item Querying the edge ids between two sets or vertices,
225#'     if both indices are used. E.g. \preformatted{  graph[[v, w, edges=TRUE]]}
226#'     gives the edge ids of all the edges that exist from vertices
227#'     \eqn{v} to vertices \eqn{w}.
228#'  }
229#'
230#' The alternative argument names \code{from} and \code{to} can be used
231#' instead of the usual \code{i} and \code{j}, to make the code more
232#' readable: \preformatted{ graph[[from = 1:3]]
233#' graph[[from = v, to = w, edges = TRUE]]}
234#'
235#' \sQuote{\code{[[}} operators allows logical indices and negative indices
236#' as well, with the usual R semantics.
237#'
238#' Vertex names are also supported, so instead of a numeric vertex id a
239#' vertex can also be given to \sQuote{\code{[}} and \sQuote{\code{[[}}.
240#'
241#' @param x The graph.
242#' @param i Index, integer, character or logical, see details below.
243#' @param j Index, integer, character or logical, see details below.
244#' @param from A numeric or character vector giving vertex ids or
245#'   names. Together with the \code{to} argument, it can be used to
246#'   query/set a sequence of edges. See details below. This argument cannot
247#'   be present together with any of the \code{i} and \code{j} arguments
248#'   and if it is present, then the \code{to} argument must be present as
249#'   well.
250#' @param to A numeric or character vector giving vertex ids or
251#'   names. Together with the \code{from} argument, it can be used to
252#'   query/set a sequence of edges. See details below. This argument cannot
253#'   be present together with any of the \code{i} and \code{j} arguments
254#'   and if it is present, then the \code{from} argument must be present as
255#'   well.
256#' @param ... Additional arguments are not used currently.
257#' @param directed Logical scalar, whether to consider edge directions
258#'   in directed graphs. It is ignored for undirected graphs.
259#' @param edges Logical scalar, whether to return edge ids.
260#' @param exact Ignored.
261#'
262#' @family structural queries
263#'
264#' @method [[ igraph
265#' @export
266
267`[[.igraph` <- function(x, i, j, from, to, ..., directed=TRUE,
268                        edges=FALSE, exact=TRUE) {
269
270  getfun <- if (edges) as_adj_edge_list else as_adj_list
271
272  if (!missing(i) && !missing(from)) stop("Cannot give both 'i' and 'from'")
273  if (!missing(j) && !missing(to)) stop("Cannot give both 'j' and 'to'")
274  if (missing(i) && ! missing(from)) i <- from
275  if (missing(j) && ! missing(to)) j <- to
276
277  if (missing(i) && missing(j)) {
278    mode <- if (directed) "out" else "all"
279    getfun(x, mode=mode)
280  } else if (missing(j)) {
281    mode <- if (directed) "out" else "all"
282    if (!edges) {
283      adjacent_vertices(x, i, mode = if (directed) "out" else "all")
284    } else {
285      incident_edges(x, i, mode = if (directed) "out" else "all")
286    }
287  } else if (missing(i)) {
288    if (!edges) {
289      adjacent_vertices(x, j, mode = if (directed) "in" else "all")
290    } else {
291      incident_edges(x, j, mode = if (directed) "in" else "all")
292    }
293  } else {
294    if (!edges) {
295      mode <- if (directed) "out" else "all"
296      lapply(adjacent_vertices(x, i, mode = mode), intersection, V(x)[j])
297    } else {
298      i <- as.igraph.vs(x, i)
299      j <- as.igraph.vs(x, j)
300      mode <- if (directed) "out" else "all"
301      ee <- incident_edges(x, i, mode = mode)
302      lapply(seq_along(i), function(yy) {
303        from <- i[yy]
304        el <- ends(x, ee[[yy]], names = FALSE)
305        other <- ifelse(el[,1]==from, el[,2], el[,1])
306        ee[[yy]][other %in% j]
307      })
308
309    }
310  }
311}
312
313#' @method [<- igraph
314#' @family functions for manipulating graph structure
315#' @export
316
317`[<-.igraph` <- function(x, i, j, ..., from, to,
318                         attr=if (is_weighted(x)) "weight" else NULL,
319                         value) {
320  ## TODO: rewrite this in C to make it faster
321
322  ################################################################
323  ## Argument checks
324  if ((!missing(from) || !missing(to)) &&
325      (!missing(i)    || !missing(j))) {
326    stop("Cannot give 'from'/'to' together with regular indices")
327  }
328  if ((!missing(from) &&  missing(to)) ||
329      ( missing(from) && !missing(to))) {
330    stop("Cannot give 'from'/'to' without the other")
331  }
332  if (is.null(attr) &&
333      (!is.null(value) && !is.numeric(value) && !is.logical(value))) {
334    stop("New value should be NULL, numeric or logical")
335  }
336  if (is.null(attr) && !is.null(value) && length(value) != 1) {
337    stop("Logical or numeric value must be of length 1")
338  }
339  if (!missing(from)) {
340    if ((!is.numeric(from) && !is.character(from)) || any(is.na(from))) {
341      stop("'from' must be a numeric or character vector without NAs")
342    }
343    if ((!is.numeric(to) && !is.character(to)) || any(is.na(to))) {
344      stop("'to' must be a numeric or character vector without NAs")
345    }
346    if (length(from) != length(to)) {
347      stop("'from' and 'to' must have the same length")
348    }
349  }
350
351  ##################################################################
352
353  if (!missing(from)) {
354    if (is.null(value) ||
355        (is.logical(value) && !value) ||
356        (is.null(attr) && is.numeric(value) && value==0)) {
357      ## Delete edges
358      todel <- x[from=from, to=to, ..., edges=TRUE]
359      x <- delete_edges(x, todel)
360    } else {
361      ## Addition or update of an attribute (or both)
362      ids <- x[from=from, to=to, ..., edges=TRUE]
363      if (any(ids==0)) {
364        x <- add_edges(x, rbind(from[ids==0], to[ids==0]))
365      }
366      if (!is.null(attr)) {
367        ids <- x[from=from, to=to, ..., edges=TRUE]
368        x <- set_edge_attr(x, attr, ids, value=value)
369      }
370    }
371  } else if (is.null(value) ||
372      (is.logical(value) && !value) ||
373      (is.null(attr) && is.numeric(value) && value==0)) {
374    ## Delete edges
375    if (missing(i) && missing(j)) {
376      todel <- unlist(x[[ ,  , ..., edges=TRUE]])
377    } else if (missing(j)) {
378      todel <- unlist(x[[i,  , ..., edges=TRUE]])
379    } else if (missing(i)) {
380      todel <- unlist(x[[ , j, ..., edges=TRUE]])
381    } else {
382      todel <- unlist(x[[i, j, ..., edges=TRUE]])
383    }
384    x <- delete_edges(x, todel)
385  } else {
386    ## Addition or update of an attribute (or both)
387    i <- if (missing(i)) as.numeric(V(x)) else as.igraph.vs(x, i)
388    j <- if (missing(j)) as.numeric(V(x)) else as.igraph.vs(x, j)
389    if (length(i) != 0 && length(j) != 0) {
390      ## Existing edges, and their endpoints
391      exe <- lapply(x[[i, j, ..., edges=TRUE]], as.vector)
392      exv <- lapply(x[[i, j, ...]], as.vector)
393      toadd <- unlist(lapply(seq_along(exv), function(idx) {
394        to <- setdiff(j, exv[[idx]])
395        if (length(to!=0)) {
396          rbind(i[idx], setdiff(j, exv[[idx]]))
397        } else {
398          numeric()
399        }
400      }))
401      ## Do the changes
402      if (is.null(attr)) {
403        x <- add_edges(x, toadd)
404      } else {
405        x <- add_edges(x, toadd, attr=structure(list(value), names=attr))
406        toupdate <- unlist(exe)
407        x <- set_edge_attr(x, attr, toupdate, value)
408      }
409    }
410  }
411  x
412}
413