Sometimes it may be useful to detect if the environment is the global environment or not and act accordingly. I have come up with what I believe is a way to detect the environment and test if it's the global environment. I just don't want to be reinventing the wheel if there's a better way or if this has holes etc. Is there some sort of built in R method to do what global_test does below or a better approach?
global_test <- function() {
environmentName(parent.frame(n = 1)) == "R_GlobalEnv"
}
global_test()
lapply(1:10, function(i) {
global_test()
})
fun <- function() global_test()
fun()
I would simplify your life a little and use identical:
global_test <- function() {
identical( parent.frame(n = 1) , globalenv() )
}
And I think this should be slightly 'safer' than doing a character comparison because you can do this:
e <- new.env()
attr(e,"name") <- "R_GlobalEnv"
# And then...
environmentName(e)
#[1] "R_GlobalEnv"
And as pointed out by #eddi, using .GlobalEnv may also not be desirable because one can do:
.GlobalEnv <- 1
identical( parent.frame(n = 1) , .GlobalEnv )
#[1] FALSE
This use of identical is in fact one of the examples from the help page on ?identical:
## even for unusual R objects :
identical(.GlobalEnv, environment())
So even if we try to trick R the function still works:
e <- new.env()
attr(e,"name") <- "R_GlobalEnv"
.GlobalEnv <- 1
global_test()
#[1] TRUE
Maybe sys.nframe?
sys.nframe() == 0L
#[1] TRUE
fun <- function() {
sys.nframe() == 0L
}
fun()
#[1] FALSE
Related
Consider this code:
bad_function <- function() {
# a lot of code
x <- 1
stop("error")
}
tryCatch(bad_function(), error = function(cond) {x})
Obviously, x is not accessible in the error handler. But is there another way to access the value of x without changing bad_function? Alternatively, is there a way to patch bad_function to skip over stop("error") and return x without having to copy all that # a lot of code?
This works if the result you are looking for is named (and the you know the name - here, x):
bad_function <- function() {
# a lot of code
x <- 1
stop("error")
}
.old_stop <- base::stopifnot
.new_stop <- function(...) {
parent.frame()$x
}
assignInNamespace("stop", .new_stop, "base")
bad_function()
assignInNamespace("stop", .old_stop, "base")
I still wonder if there are better solutions.
You could assign the value simultaneously to x in the function environment, as well to another x in an external say debug environment that you defined beforehand.
ev1 <- new.env()
bad_function <- function() {
env <- new.env(parent=baseenv())
# a lot of code
x <- ev1$x <- 1
stop("error")
}
tryCatch(bad_function(), error = function(e) ev1$x)
# [1] 1
The advantage is that .GlobalEnv stays clear (apart from the environment of course).
ls()
# [1] "bad_function" "ev1"
I would like to write a wrapper for the debug() function so that I can remove all debugging flag when needed.
For functions in the search path it is simple.
.debugged <- NULL
debug.wrapper <- function(fun){
f <- deparse(substitute(fun))
.debugged <<- unique(c(.debugged, f))
debug(f)
}
debug.wrapper.off <- function() {
z=sapply(.debugged, undebug)
.debugged <<- NULL
}
It works because I can use the character version of the function symbol.
f <- function() print("hello")
debug.wrapper(f)
isdebugged(f)
# [1] TRUE
debug.wrapper.off()
isdebugged(f)
# [1] FALSE
Anyway with namespaces it does not work:
debug.wrapper(tools:::psnice)
# Error in debug(f) could not find function "tools:::psnice"
Also:
debug(substitute(tools:::psnice))
# Error in debug(fun, text, condition) : argument must be a function
How can I store the function symbols for later reuse?
Note
It seems that concatenating function symbols creates a sort of "soft pointer" rather than a copy, that is:
x <- c(tools:::psnice, identity)
Taking the first function, we get:
x[[1]]
# function (pid = Sys.getpid(), value = NA_integer_)
# {
# res <- .Call(ps_priority, pid, value)
# if (is.na(value))
# res
# else invisible(res)
# }
# <bytecode: 0x00000000189f1f80>
# <environment: namespace:tools>
The bytecode and environment are the same as with tools:::psnice.
Therefore un/debug(x[[1]]) is like un/debug(tools:::psnice)
Solution
Given the note above, the solution is trivial. Debug wrappers are defined as:
.debugged <- NULL
debug.wrapper <- function(fun){
.debugged <<- unique(c(.debugged, fun))
debug(fun)
}
debug.wrapper.off <- function() {
z=sapply(.debugged, undebug)
.debugged <<- NULL
}
Using them brings:
f <- function() print("hello")
debug.wrapper(f)
debug.wrapper(tools:::psnice)
isdebugged(f)
# [1] TRUE
isdebugged(tools:::psnice)
# [1] TRUE
debug.wrapper.off()
isdebugged(f)
isdebugged(tools:::psnice)
.debugged
# NULL
Of course, one can add conditions to manage the case when passed fun is a string.
Thanks to #Rich Scriven, who gave useful insights.
UPDATE: I have added a variant
of Roland's implementation to the kimisc package.
Is there a convenience function for exporting objects to the global environment, which can be called from a function to make objects available globally?
I'm looking for something like
export(obj.a, obj.b)
which would behave like
assign("obj.a", obj.a, .GlobalEnv)
assign("obj.b", obj.b, .GlobalEnv)
Rationale
I am aware of <<- and assign. I need this to refactor oldish code which is simply a concatenation of scripts:
input("script1.R")
input("script2.R")
input("script3.R")
script2.R uses results from script1.R, and script3.R potentially uses results from both 1 and 2. This creates a heavily polluted namespace, and I wanted to change each script
pollute <- the(namespace)
useful <- result
to
(function() {
pollute <- the(namespace)
useful <- result
export(useful)
})()
as a first cheap countermeasure.
Simply write a wrapper:
myexport <- function(...) {
arg.list <- list(...)
names <- all.names(match.call())[-1]
for (i in seq_along(names)) assign(names[i],arg.list[[i]],.GlobalEnv)
}
fun <- function(a) {
ttt <- a+1
ttt2 <- a+2
myexport(ttt,ttt2)
return(a)
}
print(ttt)
#object not found error
fun(2)
#[1] 2
print(ttt)
#[1] 3
print(ttt2)
#[1] 4
Not tested thoroughly and not sure how "safe" that is.
You can create an environment variable and use it within your export function. For example:
env <- .GlobalEnv ## better here to create a new one :new.env()
exportx <- function(x)
{
x <- x+1
env$y <- x
}
exportx(3)
y
[1] 4
For example , If you want to define a global options(emulate the classic R options) in your package ,
my.options <- new.env()
setOption1 <- function(value) my.options$Option1 <- value
EDIT after OP clarification:
You can use evalq which take 2 arguments :
envir the environment in which expr is to be evaluated
enclos where R looks for objects not found in envir.
Here an example:
env.script1 <- new.env()
env.script2 <- new.env()
evalq({
x <- 2
p <- 3
z <- 5
} ,envir = env.script1,enclos=.GlobalEnv)
evalq({
h <- x +2
} ,envir = env.script2,enclos=myenv.script1)`
You can see that all variable are created within the environnment ( like local)
env.script2$h
[1] 4
env.script1$p
[1] 3
> env.script1$x
[1] 2
First, given your use case, I don't see how an export function is any better than using good (?) old-fashioned <<-. You could just do
(function() {
pollute <- the(namespace)
useful <<- result
})()
which will give the same result as what's in your example.
Second, rather than anonymous functions, it seems better form to use local, which allows you to run involved computations without littering your workspace with various temporary objects.
local({
pollute <- the(namespace)
useful <<- result
})
ETA: If it's important for whatever reason to avoid modifying an existing variable called useful, put an exists check in there. The same applies to the other solutions presented.
local({
.....
useful <- result
if(!exists("useful", globalenv())) useful <<- useful
})
this may seem like a overly complicated question, but it has me driving me a little nuts for some time. It is also for curiosity, because I already have a way of doing what I need, so is not that important.
In R, I need a function to return a named list object with all the arguments and the values entered by the user. For this I have made this code (toy example):
foo <- function(a=1, b=5, h='coconut') {
frm <- formals(foo)
parms <- frm
for (i in 1:length(frm))
parms[[i]] <- get(names(frm)[i])
return(parms)
}
So when this is asked:
> foo(b=0)
$a
[1] 1
$b
[1] 0
$h
[1] "coconut"
This result is perfect. The thing is, when I try to use lapply to the same goal, so as to be a little more efficient (and elegant), it does not work as I want it to:
foo <- function(a=1, b=5, h='coconut') {
frm <- formals(foo)
parms <- lapply(names(frm), get)
names(parms) <- names(frm)
return(parms)
}
The problem clearly is with the environment in which get evaluates it's first argument (a character string, the name of the variable). This I know in part from the error message:
> foo(b=0)
Error in FUN(c("a", "b", "h")[[1L]], ...) : object 'a' not found
and also, because when in the .GlobalEnv environment there are objects with the right names, foo returns their values instead:
> a <- 100
> b <- -1
> h <- 'wallnut'
> foo(b=0)
$a
[1] 100
$b
[1] -1
$h
[1] "wallnut"
Obviously, as get by default evaluates in the parent.frame(), it searches for the objects in the .GlobalEnv environment, instead of that of the current function. This is strange, since this does not happen with the first version of the function.
I have tried many options to make the function get to evaluate in the right environment, but could not do it correctly (I've tried pos=-2,0,1,2 and envir=NULL as options).
If anyone happen to know a little more than me about environments, specially in this "strange" cases, I would love to know how to solve this.
Thanks for your time,
Juan
Edit of 2013-08-05
Using sapply() instead of lapply(), simplifies this considerably:
foo4 <- function(a=1, b=5, h='coconut') {
frm <- formals(sys.function())
sapply(names(frm), get, envir=sys.frame(sys.parent(0)), simplify=FALSE)
}
foo4(b=0, h='mango')
This, though, without sapply() or lapply() might be the more elegant solution:
foo5 <- function(a=1, b=5, h='coconut') {
modifyList(formals(sys.function()), as.list(match.call())[-1])
}
foo5(b=0, h='mango')
Original post (2011-11-04)
After casting about a bit, this looks to be the best solution.
foo <- function(a=1, b=5, h='coconut') {
frm <- formals(foo)
parms <- lapply(names(frm), get, envir=sys.frame(sys.parent(0)))
names(parms) <- names(frm)
return(parms)
}
foo(b=0, h='mango')
# $a
# [1] 1
# $b
# [1] 0
# $h
# [1] "mango"
There's some subtle stuff going on here with the way that lapply scopes/evaluates the calls that it constructs. The details are hidden in a call to .Internal(lapply(X, FUN)), but for a taste, compare these two calls:
# With function matched by match.fun, search in sys.parent(0)
foo2 <- function(a=1, h='coconut') {
lapply(names(formals()),
get, envir = sys.parent(0))
}
# With anonymous function, search in sys.parent(2)
foo3 <- function(a=1, h='coconut') {
lapply(names(formals()),
FUN = function(X) get(X, envir = sys.parent(2)))
}
foo4(a=0, h='mango')
foo5(a=0, h='mango')
Just convert the current environment into a list:
foo <- function(a=1, b=5, h='coconut') {
as.list(environment())
}
foo(a = 0, h = 'mango')
This is adapted from #Josh O'Brien's solution above using sapply to automatically assign the correct names to the resulting list (saves one line of code):
foo <- function(a=1, b=5, h='coconut') {
frm <- formals(foo)
parms <- sapply(names(frm), get, envir=sys.frame(sys.parent(-1)), simplify=FALSE)
return(parms)
}
So i know in R, there is exists() which can tell whether an object exists in the environment.
What I want to test though, is the existence of multiple objects, say a, b, c in R.
Is there a function that can do something like exists(c('a','b','c')) in R and return FALSE if any one of the objects does not exist?
Thanks!
You can write your own function like this:
exists.m <- function(x) {
all(sapply(x, exists))
}
exists.m(c("mean", "sd"))
[1] TRUE
otherwise, more convenient approach is to use ... as argument in function.
exists.m <- function(...) {
ls <- list(...)
all(sapply(ls, exists))
}
exists.m("mean", "sd")
[1] TRUE
You can use ls() to check if the object exists in the environment.
a <- 1
b <- 2
all(c('a', 'b', 'c') %in% ls())
#[1] FALSE
all(c('a', 'b') %in% ls())
#[1] TRUE