Environment chaining in R - r

In my R development I need to wrap function primitives in proto objects so that a number of arguments can be automatically passed to the functions when the $perform() method of the object is invoked. The function invocation internally happens via do.call(). All is well, except when the function attempts to access variables from the closure within which it is defined. In that case, the function cannot resolve the names.
Here is the smallest example I have found that reproduces the behavior:
library(proto)
make_command <- function(operation) {
proto(
func = operation,
perform = function(., ...) {
func <- with(., func) # unbinds proto method
do.call(func, list(), envir=environment(operation))
}
)
}
test_case <- function() {
result <- 100
make_command(function() result)$perform()
}
# Will generate error:
# Error in function () : object 'result' not found
test_case()
I have a reproducible testthat test that also outputs a lot of diagnostic output. The diagnostic output has me stumped. By looking up the parent environment chain, my diagnostic code, which lives inside the function, finds and prints the very same variable the function fails to find. See this gist..
How can the environment for do.call be set up correctly?

This was the final answer after an offline discussion with the poster:
make_command <- function(operation) {
proto(perform = function(.) operation())
}

I think the issue here is clearer and easier to explore if you:
Replace the anonymous function within make_command() with a named one.
Make that function open a browser() (instead of trying to get result). That way you can look around to see where you are and what's going on.
Try this, which should clarify the cause of your problem:
test_case <- function() {
result <- 100
myFun <- function() browser()
make_command(myFun)$perform()
}
test_case()
## Then from within the browser:
#
parent.env(environment())
# <environment: 0x0d8de854>
# attr(,"class")
# [1] "proto" "environment"
get("result", parent.env(environment()))
# Error in get("result", parent.env(environment())) :
# object 'result' not found
#
parent.frame()
# <environment: 0x0d8ddfc0>
get("result", parent.frame()) ## (This works, so points towards a solution.)
# [1] 100
Here's the problem. Although you think you're evaluating myFun(), whose environment is the evaluation frame of test_case(), your call to do.call(func, ...) is really evaluating func(), whose environment is the proto environment within which it was defined. After looking for and not finding result in its own frame, the call to func() follows the rules of lexical scoping, and next looks in the proto environment. Neither it nor its parent environment contains an object named result, resulting in the error message you received.
If this doesn't immediately make sense, you can keep poking around within the browser. Here are a few further calls you might find helpful:
environment(get("myFun", parent.frame()))
ls(environment(get("myFun", parent.frame())))
environment(get("func", parent.env(environment())))
ls(environment(get("func", parent.env(environment()))))

Related

R Why do I have to assign a formal argument variable to itself in order for this function to work?

I have developed the following two functions:
save_sysdata <- function(...) {
data <- eval(substitute(alist(...)))
data <- purrr::map_chr(data, add_dot)
save(list = data, file = "sysdata.rda", compress = "bzip2", version = 2)
}
add_dot <- function(object) {
object <- object # Why is this required?
name <- paste0(".", deparse(substitute(object)))
# parent.frame(3) because evaluating in global (or caller function); 2 because assigning in save_sysdata.
assign(name, eval(object, envir = parent.frame(3)), envir = parent.frame(2))
return(name)
}
The purpose of this set of functions is to provide an object (x) and save it as a sysdata.rda file but as a hidden object. This requires adding a . to the object symbol (.x).
The set of functions as I have it works and accomplishes what I want. However, it requires a bit of code that I don't understand why it works or what it's doing. I'm not even sure how I came up with this particular line as a solution.
If I remove the line object <- object from the add_dot function, the whole thing fails to work. It actually just generates an empty sysdata.rda file.
Can anyone explain why this line is necessary and what it is doing?
And if you have a more efficient way of accomplishing this, please let me know. It was a fun exercise to figure this out myself but I'm sure there is a better way.
For a reprex, simply copy the above functions and run:
x <- "test"
save_sysdata(x)
Then load the sysdata.rda file into your global environment and type .x. You should return [1] "test".
Here's an alternative version
save_sysdata <- function(...) {
pnames <- sapply(match.call(expand.dots=FALSE)$..., deparse)
snames <- paste0(".", pnames)
senv <- setNames(list(...), snames)
save(list = snames, envir=list2env(senv), file = "sysdata.rda", compress = "bzip2", version = 2)
}
We dump the values into a named list and granbing the names of the parameter with match.call(). We add dots to the names and then turn that list into an environment that we can use with save.
The reason your version required object <- object is that function parameters are lazily evaluated. Since you never actually use the value of that object in your function without the assignment, it remains a promise and is never added tot he function environment. Sometimes you'll see force(object) instead which does the same thing.

How to subclass a function in R?

I was wondering if it is possible to use Reference Classes to subclass a function in R. For instance, the following
> CustomFunction <- setRefClass("CustomFunction", contains = "function")
> foo <- CustomFunction()
> foo()
NULL
works OK (does not throw an error), but how can I customise the behaviour (i.e. other than returning NULL)? How can I define function arguments?
I also tried
> setMethod("(",
> signature(x = "CustomFunction"),
> function(...) {
> "Hello!" # A function that always returns "Hello!"
> }
> )
Error in genericForPrimitive(f) :
methods may not be defined for primitive function ‘(’ in this version of R
but that doesn't seem to work.
I was hoping that being able to subclass functions means that I could implement custom behaviour before and after function calls. E.g. to have functions that automatically logs the call expression each time it is called (for audit purposes), or to create functions that automatically throws an error if NULL is returned etc etc.
You don't need Reference Classes for this, you can just enclose the function of interest
logger <- function(f) {
force(f)
function(...) {
print("running function...")
f(...)
}
}
printhello <- function(name="Al") print(paste("hello", name))
printhello_logged <- logger(printhello)
printhello()
# [1] "hello Al"
printhello_logged("Zed")
# [1] "running function..."
# [1] "hello Zed"
If this is for auditing/testing type purposes, you might be interested in trace() which allows you to attach code to various parts of functions.

Resuming stopped evaluation in R with correct search path

I have a function within a loaded library that stops the evaluation on its arguments using the substitute function. This function then calls another within that same library, which calls another function from that library, and so forth, until several calls later when I want to evaluated that initial argument in the original environment in which it was provided. The problem I have is that the search path for functions in loaded libraries includes namespace::base before the global environment. For example, let's say that foo and bar are both functions in the library lib. As such, the environment in which they are defined is namespace::lib. Consider the following:
> require(lib)
> foo
function (x)
{
x <- substitute(x)
bar(x)
}
<environment: namespace:lib>
> bar
function (x)
{
eval(x)
}
<environment: namespace:lib>
> length = 2
> foo(length)
function (x) .Primitive("length")
Because bar is a function within a loaded library, it searches namespace::base first and finds the above. However, if bar was defined by the user in the interactive session, it would have returned 2. I am looking for a way to cause these functions to behave as if I never halted evaluation, in which case 2 would be returned regardless of the environment in which the functions are defined.
I can't simply use mget to evaluate length starting at .GlobalEnv because then the following would not work:
> baz = function()
+ {
+ length <- 3
+ foo(length)
+ }
> baz()
function (x) .Primitive("length")
I could instead add an extra argument to all involved functions that tracks how many frames ago the evaluation was halted. However, this is pretty messy and not ideal.
I could also call sys.function inside the last function, bar, and trace my way back through the previous calls and evaluate my argument in the environment above the function that halted the evaluation. For example, if I call sys.function(1) within the body of bar after calling foo(length) then I get the following:
function (x)
{
eval(x)
}
This is indeed identical to foo. I can then use eval with sys.frames. This seems more general but less than perfect. I would have to know which functions stop evaluation.
Does anyone have a more general solution?
Does adding a default enviroment to these function help with the problem?
lib<-new.env()
assign("foo", function(x, env=parent.frame()) {
x<-substitute(x);
bar(x, env)
}, envir=lib)
assign("bar", function(x, env=parent.frame()) {
eval(x, env)
}, envir=lib)
attach(lib)
length = 2
foo(length)
# [1] 2
baz <- function() {
length <- 3
foo(length)
}
baz()
# [1] 3
bar(expression(baz()))
# [1] 3
If not, perhaps you could make a clearer, reproducible example with function calls and your expected output. Otherwise it's unclear where you are having trouble.

When/how/where is parent.frame in a default argument interpreted?

Truth be told, I'm just being lazy here, but perhaps someone could someday profit from the answer being here.
Say I define a function like:
fn<-function(envir=parent.frame())
{
#do something with envir
}
My question is: what might I expect to be the content of envir?
Context: I had a rather long function f1 that contained a call to parent.frame. Now, I want to extract part of that function (containing the parent.frame call) into a new helper function f2 (which will then be called by f1), and I want to be sure that f1 does the same as it did before.
Default arguments are evaluated within the evaluation frame of the function call, from which place parent.frame() is the calling environment. envir's value will thus be a pointer to the environment from which fn was called.
Also, just try it out to see for yourself:
debug(fn)
fn()
# debugging in: fn()
# debug at #2: {
# }
Browse[2]> envir
# <environment: R_GlobalEnv>

R warning() wrapper - raise to parent function

I have a wrapper around the in-built warning() function in R that basically calls warning(sprintf(...)):
warningf <- function(...)
warning(sprintf(...))
This is because I use warning(sprintf(...)) so often that I decided to make a function out of it (it's in a package I have of functions I use often).
I then use warningf when I write functions. i.e., instead of writing:
f <- function() {
# ... do stuff
warning(sprintf('I have %i bananas!',2))
# ... do stuff
}
I write:
f <- function() {
# ... do stuff
warningf('I have %i bananas!',2)
# ... do stuff
}
If I call the first f(), I get:
Warning message:
In f() : I have 2 bananas!
This is good - it tells me where the warning came from f() and what went wrong.
If I call the second f(), I get:
Warning message:
In warningf("I have %i bananas!",2) : I have 2 bananas!
This is not ideal - it tells me the warning was in the warningf function (of course, because it's the warningf function that calls warning, not f), masking the fact that it actually came from the f() function.
So my question is : Can I somehow "raise" the warning call so it displays the warning in f() message instead of the warning in warningf ?
One way of dealing with this is to get a list of the environments in your calling stack, and then pasting the name of the parent frame in your warning.
You do this with the function sys.call() which returns an item in the call stack. You want to extract the second from last element in this list, i.e. the parent to warningf:
warningf <- function(...){
parent.call <- sys.call(sys.nframe() - 1L)
warning(paste("In", deparse(parent.call), ":", sprintf(...)), call.=FALSE)
}
Now, if I run your function:
> f()
Warning message:
In f() : I have 2 bananas!
Later edit : deparse(parent.call) converts the call to a string in the case that the f() function had arguments, and shows the call as it was specified (ie including arguments etc).
I know it's old but, sys.call(sys.nframe() - 1L), or sys.call(-1),
returns a vector, with the function name and the argument.
If you use it inside paste() it will raise two warnings, one from the function and one from the argument.
The answer doesn't show because f() has no arguments.
sys.call(sys.nframe() - 1L)[1] does the trick.

Resources