更新:
这是一个新版本,它解决了两个问题:
a) 以前的版本只是简单地sys.frames()
向后遍历。此版本将遵循parent.frames()
直到达到.GlobalEnv
. 这在例如应该忽略 ' 框架的情况subscramble
下很重要。scramble
substitute
b) 这个版本每个级别都有一个。这可以防止第二次substitute
调用替换第一次substitute
调用引入的更高级别的符号。
subset <- function(x, condition) {
call <- substitute(condition)
frames <- sys.frames()
parents <- sys.parents()
# starting one frame up, keep climbing until we get to .GlobalEnv
i <- tail(parents, 1)
while(i != 0) {
f <- sys.frames()[[i]]
# copy x into f, except for variable with conflicting names.
xnames <- setdiff(ls(x), ls(f))
for (n in xnames) assign(n, x[[n]], envir=f)
call <- eval(substitute(substitute(expr, f), list(expr=call)))
# leave f the way we found it
rm(list=xnames, envir=f)
i <- parents[i]
}
r <- eval(call, x, .GlobalEnv)
x[r, ]
}
这个版本通过了@hadley 的评论测试:
mtcars $ condition <- 4; subscramble(mtcars, cyl == 4)
不幸的是,以下两个示例现在表现不同:
cyl <- 6; subset(mtcars, cyl==4)
local({cyl <- 6; subset(mtcars, cyl==4)})
这是对 Josh 的第一个函数的轻微修改。在堆栈中的每一帧,我们x
在从帧中替换之前替换。这意味着数据框中的符号在每一步都具有优先权。我们可以通过在循环中_dat
跳过subset
's 帧来避免伪生成符号。for
subset <- function(x, condition) {
call <- substitute(condition)
frames <- rev(sys.frames())[-1]
for(f in frames) {
call <- eval(substitute(substitute(expr, x), list(expr=call)))
call <- eval(substitute(substitute(expr, f), list(expr=call)))
}
r <- eval(call, x, .GlobalEnv)
x[r, ]
}
这个版本在简单的情况下工作(值得检查我们没有回归):
subset(mtcars, cyl == 4)
# mpg cyl disp hp drat wt qsec vs am gear carb
# Datsun 710 22.8 4 108.0 93 3.85 2.320 18.61 1 1 4 1
# Merc 240D 24.4 4 146.7 62 3.69 3.190 20.00 1 0 4 2
# Merc 230 22.8 4 140.8 95 3.92 3.150 22.90 1 0 4 2
# Fiat 128 32.4 4 78.7 66 4.08 2.200 19.47 1 1 4 1
# Honda Civic 30.4 4 75.7 52 4.93 1.615 18.52 1 1 4 2
# Toyota Corolla 33.9 4 71.1 65 4.22 1.835 19.90 1 1 4 1
# Toyota Corona 21.5 4 120.1 97 3.70 2.465 20.01 1 0 3 1
# Fiat X1-9 27.3 4 79.0 66 4.08 1.935 18.90 1 1 4 1
# Porsche 914-2 26.0 4 120.3 91 4.43 2.140 16.70 0 1 5 2
# Lotus Europa 30.4 4 95.1 113 3.77 1.513 16.90 1 1 5 2
# Volvo 142E 21.4 4 121.0 109 4.11 2.780 18.60 1 1 4 2
它也适用于subscramble
and f
:
scramble <- function(x) x[sample(nrow(x)), ]
subscramble <- function(x, condition) scramble(subset(x, condition))
subscramble(mtcars, cyl == 4) $ cyl
# [1] 4 4 4 4 4 4 4 4 4 4 4
f <- function() {cyl <- 4; g()}
g <- function() subset(mtcars, cyl == 4) $ cyl
g()
# [1] 4 4 4 4 4 4 4 4 4 4 4
甚至可以在一些更棘手的情况下工作:
gear5 <- function(z, condition) {
x <- 5
subset(z, condition & (gear == x))
}
x <- 4
gear5(mtcars, cyl == x)
# mpg cyl disp hp drat wt qsec vs am gear carb
# Porsche 914-2 26.0 4 120.3 91 4.43 2.140 16.7 0 1 5 2
# Lotus Europa 30.4 4 95.1 113 3.77 1.513 16.9 1 1 5 2
for
循环内的行可能需要一些解释。假设call
分配如下:
call <- quote(y == x)
str(call)
# language y == x
我们想将值替换4
为x
in call
。但是直截了当的方法是行不通的,因为我们想要的是 的内容call
,而不是符号call
。
substitute(call, list(x=4))
# call
所以我们使用另一个substitute
调用来构建我们需要的表达式。
substitute(substitute(expr, list(x=4)), list(expr=call))
# substitute(y == x, list(x = 4))
现在我们有了一个描述我们想要做什么的语言对象。剩下的就是让它真正做到这一点:
eval(substitute(substitute(expr, list(x=4)), list(expr=call)))
# y == 4