1
2## -----------------------------------------------------------------------
3##
4##   IGraph R package
5##   Copyright (C) 2014  Gabor Csardi <csardi.gabor@gmail.com>
6##   334 Harvard street, Cambridge, MA 02139 USA
7##
8##   This program is free software; you can redistribute it and/or modify
9##   it under the terms of the GNU General Public License as published by
10##   the Free Software Foundation; either version 2 of the License, or
11##   (at your option) any later version.
12##
13##   This program is distributed in the hope that it will be useful,
14##   but WITHOUT ANY WARRANTY; without even the implied warranty of
15##   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
16##   GNU General Public License for more details.
17##
18##   You should have received a copy of the GNU General Public License
19##   along with this program; if not, write to the Free Software
20##   Foundation, Inc.,  51 Franklin Street, Fifth Floor, Boston, MA
21##   02110-1301 USA
22##
23## -----------------------------------------------------------------------
24
25make_call <- function(f, ..., .args = list()) {
26  if (is.character(f)) f <- as.name(f)
27  as.call(c(f, ..., .args))
28}
29
30do_call <- function(f, ..., .args = list(), .env = parent.frame()) {
31  f <- substitute(f)
32
33  call <- make_call(f, ..., .args)
34  eval(call, .env)
35}
36
37add_class <- function(x, class) {
38  if (!is(x, class)) {
39    class(x) <- c(class, class(x))
40  }
41  x
42}
43
44`%||%` <- function (lhs, rhs) {
45  lres <- withVisible(eval(lhs, envir = parent.frame()))
46  if (is.null(lres$value)) {
47    eval(rhs, envir = parent.frame())
48  } else {
49    if (lres$visible) {
50      lres$value
51    } else {
52      invisible(lres$value)
53    }
54  }
55}
56
57`%&&%` <- function(lhs, rhs) {
58  lres <- withVisible(eval(lhs, envir = parent.frame()))
59  if (!is.null(lres$value)) {
60    eval(rhs, envir = parent.frame())
61  } else {
62    if (lres$visible) {
63      lres$value
64    } else {
65      invisible(lres$value)
66    }
67  }
68}
69
70## Grab all arguments of the parent call, in a list
71
72grab_args <- function() {
73  envir <- parent.frame()
74  func <- sys.function(-1)
75  call <- sys.call(-1)
76  dots <- match.call(func, call, expand.dots=FALSE)$...
77  c(as.list(envir), dots)
78}
79
80capitalize <- function(x) {
81  x <- tolower(x)
82  substr(x, 1, 1) <- toupper(substr(x, 1, 1))
83  x
84}
85
86address <- function(x) {
87  .Call(C_R_igraph_address, x)
88}
89
90`%+%` <- function(x, y) {
91  stopifnot(is.character(x), is.character(y))
92  paste0(x, y)
93}
94
95chr <- as.character
96
97drop_null <- function(x) {
98  x [!sapply(x, is.null)]
99}
100