Hi all,
It seems that there is a use case for obtaining the environment for the
"top" promise. By "top", I mean following the promise chain up the call
stack until hitting a non-promise.
S4 data containers often mimic the API of base R data structures. This
means writing S4 methods for functions that quote their arguments, like
with() and subset(). The methods package directly forwards any arguments
not used for dispatch, so substitute(subset) is able to resolve the
original quoted argument (this is not the case for naively written
wrappers). The problem then becomes figuring out the environment in which
to evaluate the expression.
Consider:
setClass("A", representation(df = "data.frame"))
setMethod("subset", "A", function(x, subset) {
env <- parent.frame(2)
x at df <- x at df[eval(substitute(subset), x at df, env),,drop=FALSE]
x
})
dropLowMpg <- function(x, cutoff=20) {
invisible(subset(x, mpg > cutoff))
}
a <- new("A", df=mtcars)
dropLowMpg(a)
The above works just fine, because we figured out that we need to evaluate
in the grand-parent frame to avoid the frame of the generic call. But now
let's assume A has a subclass B, and subset,B delegates to subset,A via
callNextMethod(). The call stack is different, and our assumption is
invalid.
setClass("B", representation(nrow="integer"), contains="A")
setMethod("subset", "B", function(x, ...) {
ans <- callNextMethod()
ans at nrow <- nrow(ans at df)
ans
})
b <- new("B", df=mtcars)
dropLowMpg(b)
Error in eval(expr, envir, enclos) (from #3) : object 'cutoff' not found
We can fix this with a simple C function:
SEXP top_prenv(SEXP nm, SEXP env)
{
SEXP promise = findVar(nm, env);
while(TYPEOF(promise) == PROMSXP) {
env = PRENV(promise);
promise = PREXPR(promise);
}
return env;
}
With R wrapper:
top_prenv <- function(x) {
.Call2("top_prenv", substitute(x), parent.frame())
}
Then this works (need to set subset,B again to reset cache):
setMethod("subset", "A", function(x, subset) {
env <- top_prenv(subset)
x at df <- x at df[eval(substitute(subset), x at df, env),,drop=FALSE]
x
})
setMethod("subset", "B", function(x, ...) {
ans <- callNextMethod()
ans at nrow <- nrow(ans at df)
ans
})
b <- new("B", df=mtcars)
dropLowMpg(b)
Would this be a useful addition to R? Is there a better way to solve this
issue? We're using this successfully in the IRanges package now, but we'd
like to avoid dealing with the internal details of R, and this is something
that could be of general benefit.
Thanks,
Michael
[[alternative HTML version deleted]]