Replace and restore the object in `globalenv()` during a function call - r

I need to call a function, named g, whose behavior depends on the variable under globalenv() several times. For convenience, I try to wrap it into a helper function, named f. However, I hope that after executing f, the globalenv() is invariant.
Here is my implementation so far:
g <- function(name) {
print(globalenv()[[name]])
}
f <- function(w) {
# backup "w" in globalenv if needed
is_existed.w <- !is.null(globalenv()[["w"]])
if (is_existed.w) {
temp.w <- globalenv()[["w"]]
}
w <<- w
g("w")
# restore w if needed
if (is_existed.w) {
w <<- temp.w
}
}
w <- "a"
f("gg")
w
However, this approach is very tedious. I need to copy-paste many times. Is there an more elegant way to implement this?

Why do you need to copy and paste? If it is because you'd want to save different variables, or call different functions, you could pass both of these as arguments to a higher order function, i.e. a function returning a function, like this:
wrap <- function(name, g) {
f <- function(value, ...) {
old <- globalenv()[[name]]
assign(name, value, globalenv())
res <- g(...)
if (!is.null(old))
assign(name, old, globalenv())
return (res)
}
return (f)
}
You could then create your f using wrap("w", g) and call it using f("gg", "w"), the latter "w" being the name of the variable you want to print.

Related

R function for obtaining a reference to a variable

In Advanced R, environments are advertised as a useful way to get pass-by-reference semantics in R: instead of passing a list, which gets copied, I can pass an environment, which is not. This is useful to know.
But it assumes that whoever is calling my function is happy to agree on an "environment"-based data type, with named slots corresponding to the variables we want to modify.
Hasn't someone made a class which allows me to just refer to a single variable by reference? For example,
v = 1:5
r <- ref(v)
(function() {
getRef(r) # same as v
setRef(r, 1:6) # same as v <<- 1:6, in this case
})()
It would seem to be pretty easy to do this, by storing the character name of v together with the environment where it is bound.
Is there a standard library which accomplishes this semantics, or can someone provide a short snippet of code? (I haven't finished reading "Advanced R"; apologies if this is covered later in the book)
As you have already mentioned in your question, you can store the variable name and its environment and access it with get and assign what will be somehow like a reference to a single variable.
v <- 1:5
r <- list(name="v", env=environment())
(function() {
get(r$name, envir = r$env)
assign(r$name, 1:6, envir = r$env)
})()
v
#[1] 1 2 3 4 5 6
Alternatively you can store the reference to an environment but then you can access everything in this referenced environment.
v <- 1:5
r <- globalenv() #reference to everything in globalenv
(function() {
r$v
r$v <- 1:6
})()
v
#[1] 1 2 3 4 5 6
You can also create an environment with only one variable and make a reference to it.
v <- new.env(parent=emptyenv())
v$v <- 1:5
r <- v
(function() {
r$v
r$v <- 1:6
})()
v$v
#[1] 1 2 3 4 5 6
Implemented as functions using find or set the environment during creation. Have also a look at How to get environment of a variable in R.
ref <- function(name, envir = NULL) {
name <- substitute(name)
if (!is.character(name)) name <- deparse(name)
if(length(envir)==0) envir <- as.environment(find(name))
list(name=name, envir=envir)
}
getRef <- function(r) {
get(r$name, envir = r$envir, inherits = FALSE)
}
setRef <- function(r, x) {
assign(r$name, x, envir = r$envir, inherits = FALSE)
}
x <- 1
r1 <- ref(x) #x from Global Environment
#x from Function Environment
r2 <- (function() {x <- 2; ref(x, environment())})()
#But simply returning x might here be better
r2b <- (function() {x <- 2; x})()
a <- new.env(parent=emptyenv())
a$x <- 3
r3 <- ref(x, a) #x from Environment a
This is based on GKi's answer, thanks to him for stepping up.
It includes pryr::where so you don't have to install the whole library
Note that we need to point "where" to parent.frame() in the definition of "ref"
Added some test cases which I used to check correctness
The code:
# copy/modified from pryr::where
where = function(name, env=parent.frame()) {
if (identical(env, emptyenv())) {
stop("Can't find ", name, call. = FALSE)
}
if (exists(name, env, inherits = FALSE)) {
env
} else {
where(name, parent.env(env))
}
}
ref <- function(v) {
arg <- deparse(substitute(v))
list(name=arg, env=where(arg, env=parent.frame()))
}
getRef <- function(r) {
get(r$name, envir = r$env, inherits = FALSE)
}
setRef <- function(r, x) {
assign(r$name, x, envir = r$env)
}
if(1) { # tests
v <- 1:5
r <- ref(v)
(function() {
stopifnot(identical(getRef(r),1:5))
setRef(r, 1:6)
})()
stopifnot(identical(v,1:6))
# this refers to v in the global environment
v=2; r=(function() {ref(v)})()
stopifnot(getRef(r)==2)
setRef(r,5)
stopifnot(getRef(r)==5)
stopifnot(v==5)
# same as above
v=2; r=(function() {v <<- 3; ref(v)})()
stopifnot(getRef(r)==3)
setRef(r,5)
stopifnot(getRef(r)==5)
stopifnot(v==5)
# this creates a local binding first, and refers to that. the
# global binding is unaffected
v=2; r=(function() {v=3; ref(v)})()
stopifnot(getRef(r)==3)
setRef(r,5)
stopifnot(getRef(r)==5)
stopifnot(v==2)
# additional tests
r=(function() {v=4; (function(v1) { ref(v1) })(v)})()
stopifnot(r$name=="v1")
stopifnot(getRef(r)==4)
setRef(r,5)
stopifnot(getRef(r)==5)
# check that outer v is not modified
v=2; r=(function() {(function(v1) { ref(v1) })(v)})()
stopifnot(getRef(r)==2)
setRef(r,5)
stopifnot(getRef(r)==5)
stopifnot(v==2)
}
I imagine there may be some garbage collection inefficiency if you're creating a reference to a small variable in a temporary environment with a different large variable, since the reference must retain the whole environment - although the same problem could arise with other uses of lexical scoping.
I will probably use this code next time I need pass-by-reference semantics.

Access enclosed variables through outer function called within closure

The following code is supposed to change the value of the enclosed variable some.var calling the function set.var. The latter calls itself the outer function g, whose environment is changed to the parent environment of set.var
new.obj <- function(){
some.var = NULL
set.var <- function(...) {
environment(g) <- parent.frame()
g(x="some.var", ...)
}
get.var <- function(){some.var}
return(list(set.var=set.var, get.var=get.var))
}
g <- function(x) assign(x,1)
However, obj<-new.obj(); obj$set.var(); obj$get.var() returns NULL. What goes wrong here and how can the behaviour be fixed?
The reason why I am considering this construction is, that I would like to reuse the code within g in different closures. Hence, it should be placed outside of these.
I suspect that you are making things more complicated than necessary. Take a look at this example and comment if you need to achieve something that this cannot do:
do_the_job <- function(x) {
return(x * 1000)
}
wrapper_function <- function(y) {
return( do_the_job(y) )
}
my_value <- 5
my_new_value <- wrapper_function(my_value)
Not entirely sure what I'm doing here myself.
I hope it helps/inspires you:
new.obj <- function(){
env1 <- new.env()
env1$some.var = NULL
f <- function() {
environment(g) <- parent.frame()
g(x="some.var", envir = env1)
}
get.var <- function(){ env1$some.var }
return(list(f=f, get.var=get.var))
}
g <- function(x, ...) assign(x, "hihi_changed", envir = ...)
obj<-new.obj(); obj$get.var() null is returned as we expect.
obj$f(); obj$get.var() function g is called eventually that changes some.var.
My trick is to add the variable some.var to a new environment and always refer to that env1 environment.
So in function g(), always use the ellipsis to refer to the new.obj environment env1, where currently some.var lives.
Hope this keeps you going.

curve3d can't find local function "fn"

I'm trying to use the curve3d function in the emdbook-package to create a contour plot of a function defined locally inside another function as shown in the following minimal example:
library(emdbook)
testcurve3d <- function(a) {
fn <- function(x,y) {
x*y*a
}
curve3d(fn(x,y))
}
Unexpectedly, this generates the error
> testcurve3d(2)
Error in fn(x, y) : could not find function "fn"
whereas the same idea works fine with the more basic curve function of the base-package:
testcurve <- function(a) {
fn <- function(x) {
x*a
}
curve(a*x)
}
testcurve(2)
The question is how curve3d can be rewritten such that it behaves as expected.
You can temporarily attach the function environment to the search path to get it to work:
testcurve3d <- function(a) {
fn <- function(x,y) {
x*y*a
}
e <- environment()
attach(e)
curve3d(fn(x,y))
detach(e)
}
Analysis
The problem comes from this line in curve3d:
eval(expr, envir = env, enclos = parent.frame(2))
At this point, we appear to be 10 frames deep, and fn is defined in parent.frame(8). So you can edit the line in curve3d to use that, but I'm not sure how robust this is. Perhaps parent.frame(sys.nframe()-2) might be more robust, but as ?sys.parent warns there can be some strange things going on:
Strictly, sys.parent and parent.frame refer to the context of the
parent interpreted function. So internal functions (which may or may
not set contexts and so may or may not appear on the call stack) may
not be counted, and S3 methods can also do surprising things.
Beware of the effect of lazy evaluation: these two functions look at
the call stack at the time they are evaluated, not at the time they
are called. Passing calls to them as function arguments is unlikely to
be a good idea.
The eval - parse solution bypasses some worries about variable scope. This passes the value of both the variable and function directly as opposed to passing the variable or function names.
library(emdbook)
testcurve3d <- function(a) {
fn <- eval(parse(text = paste0(
"function(x, y) {",
"x*y*", a,
"}"
)))
eval(parse(text = paste0(
"curve3d(", deparse(fn)[3], ")"
)))
}
testcurve3d(2)
I have found other solution that I do not like very much, but maybe it will help you.
You can create the function fn how a call object and eval this in curve3d:
fn <- quote((function(x, y) {x*y*a})(x, y))
eval(call("curve3d", fn))
Inside of the other function, the continuous problem exists, a must be in the global environment, but it is can fix with substitute.
Example:
testcurve3d <- function(a) {
fn <- substitute((function(x, y) {
c <- cos(a*pi*x)
s <- sin(a*pi*y/3)
return(c + s)
})(x, y), list(a = a))
eval(call("curve3d", fn, zlab = "fn"))
}
par(mfrow = c(1, 2))
testcurve3d(2)
testcurve3d(5)

Evaluate an expression into a given environment

I would like to call a function inside a given environment so that the execution of the function does not mess the global environment. I have something like that:
f <- function() { x <<- 5 }
e <- new.env()
evalq(f(), envir = e)
I want to evaluate f() inside the environment e, but it seems it does not work since the variable x is accessible from the global env instead of the env e. I mean I want to access x by typing e$x, not x.
I tried to build the function f inside e like this:
e <- new.env()
evalq(f <- function() { x <<- 5 }, envir = e)
evalq(f(), envir = e)
But it still does not work, x is in the global env, not in e.
EDIT with more informations:
From the answers I received, I understand that <<- should not be used. The problem is that, in practice, I don't know what f is, since it is obtained by sourcing a file which is downloaded through a shiny app. The purpose of this app is to evaluate a classifier function f written by students. So in case they used the <<- operator in their function, I don't want to pollute my global env (which seem to be impossible from the description of the <<- operator).
I think I could remove the potentially created variables with something like
vars <- ls()
evalq(f(), envir = e)
new_vars <- ls()
rm(list = new_vars[!new_vars %in% vars])
But is there a better solution?
You can use assign to define the environment where the object should be created:
e <- new.env()
f <- function() {
assign("x", 5, envir = e)
}
f()
x
# Error: object 'x' not found
e$x
# [1] 5
As #lmo says, the simplest way would be to not use <<- to do this. Also, the function runs in its own environment so if you were to use <- you would need to assign the output of the function to a variable (otherwise it is only created in the f's temporary environment. Something like this would work:
f <- function() { x <- 5 }
e <- new.env()
evalq(x <- f(), envir = e)
e$x
#[1] 5

Allowing R functions to directly alter the parent environment

I'm trying to figure out how to allow a function to directly alter or create variables in its parent environment, whether the parent environment is the global environment or another function.
For example if I have a function
my_fun <- function(){
a <- 1
}
I would like a call to my_fun() to produce the same results as doing a <- 1.
I know that one way to do this is by using parent.frame as per below but I would prefer a method that doesn't involve rewriting every variable assignment.
my_fun <- function(){
env = parent.frame()
env$a <- 1
}
Try with:
g <- function(env = parent.frame()) with(env, { b <- 1 })
g()
b
## [1] 1
Note that normally it is preferable to pass the variables as return values rather than directly create them in the parent frame. If you have many variables to return you can always return them in a list, e.g. h <- function() list(a = 1, b = 2); result <- h() Now result$a and result$b have the values of a and b.
Also see Function returning more than one value.

Resources