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