12

如subset()手册所述：

警告：这是一个旨在交互使用的便利功能

我从这篇很棒的文章中不仅学到了这个警告背后的秘密，而且很好地理解了substitute(), match.call(), eval(), quote(), ‍<code>callpromise和其他相关的 R 主题，这些主题有点复杂。

现在我明白了上面的警告是什么。一个超级简单的实现subset()可能如下：

subset = function(x, condition) x[eval(substitute(condition), envir=x),]

虽然返回满足subset(mtcars, cyl==4)的行表，但封装在另一个函数中失败：mtcarscyl==4subset()

sub = function(x, condition) subset(x, condition)

sub(mtcars, cyl == 4)
# Error in eval(expr, envir, enclos) : object 'cyl' not found

使用 的原始版本subset()也会产生完全相同的错误情况。这是由于substitute()-eval()pair 的限制：虽然conditionis可以正常工作cyl==4，但是当condition通过包络函数传递时sub()，condition参数subset()将不再是cyl==4，而是嵌套condition在sub()主体中，并且eval()失败 - 这有点复杂。

但是它是否存在subset()具有完全相同的参数的任何其他实现，这些参数将是编程安全的 - 即能够在另一个函数调用它时评估它的条件？

4

4 回答 4

8

[ 功能是您正在寻找的。?"["。mtcars[mtcars$cyl == 4,]等效于子集命令并且是“编程”安全的。

sub = function(x, condition) {
 x[condition,]
}

sub(mtcars, mtcars$cyl==4)

with()在函数调用中没有隐含的情况下执行您的要求。细节很复杂，但功能如下：

sub = function(x, quoted_condition) {
  x[with(x, eval(parse(text=quoted_condition))),]
}

sub(mtcars, 'cyl==4')

Sorta 可以满足您的需求，但在某些极端情况下，这会产生意想不到的结果。

使用data.table和[子集函数，您可以获得with(...)您正在寻找的隐式。

library(data.table)
MT = data.table(mtcars)

MT[cyl==4]

有更好、更快的方法可以在 中进行此子集化data.table，但这很好地说明了这一点。

使用data.table您还可以构造表达式以供稍后评估

cond = expression(cyl==4)

MT[eval(cond)]

这两个现在可以通过函数传递：

wrapper = function(DT, condition) {
  DT[eval(condition)]
}
于 2012-10-11T23:39:38.280 回答
7

这是一个替代版本，subset()即使它是嵌套的，它也可以继续工作——至少只要将逻辑子集表达式（例如cyl == 4）提供给顶级函数调用。

它通过爬上调用堆栈来工作，substitute()在每个步骤中最终捕获用户传入的逻辑子集表达式。sub2()例如，在下面的调用中，for循环将调用堆栈从expr到x到AA最后到cyl ==4。

SUBSET <- function(`_dat`, expr) {
    ff <- sys.frames()
    ex <- substitute(expr)
    ii <- rev(seq_along(ff))
    for(i in ii) {
        ex <- eval(substitute(substitute(x, env=sys.frames()[[n]]),
                              env = list(x = ex, n=i)))
    }
    `_dat`[eval(ex, envir = `_dat`),]
}

## Define test functions that nest SUBSET() more and more deeply
sub <- function(x, condition) SUBSET(x, condition)
sub2 <- function(AA, BB) sub(AA, BB)

## Show that it works, at least when the top-level function call
## contains the logical subsetting expression
a <- SUBSET(mtcars, cyl == 4)  ## Direct call to SUBSET()
b <- sub(mtcars, cyl == 4)     ## SUBSET() called one level down
c <- sub2(mtcars, cyl == 4)    ## SUBSET() called two levels down

identical(a,b)
# [1] TRUE
> identical(a,c)
# [1] TRUE
a[1:5,]
#                 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

** 有关for循环内部构造的一些解释，请参阅R 语言定义手册的第 6.2 节第 6 段。

于 2012-10-12T03:57:59.160 回答
4

仅仅因为它是如此令人费解的乐趣（？？），这里有一个稍微不同的解决方案，它解决了哈德利在对我接受的解决方案的评论中指出的问题。

Hadley发布了一个要点，展示了我接受的功能出错的情况。该示例中的扭曲（复制如下）是传递给的符号SUBSET()是在调用函数之一的主体（而不是参数）中定义的；因此，它被substitute()而不是预期的全局变量捕获。令人困惑的东西，我知道。

f <- function() {
  cyl <- 4
  g()
}

g <- function() {
  SUBSET(mtcars, cyl == 4)$cyl
}
f()

这是一个更好的函数，它只会替换调用函数的参数列表中的符号值。它适用于 Hadley 或我迄今为止提出的所有情况。

SUBSET <- function(`_dat`, expr) {
   ff <- sys.frames()
   n <- length(ff)
   ex <- substitute(expr)
   ii <- seq_len(n)
   for(i in ii) {
       ## 'which' is the frame number, and 'n' is # of frames to go back.
       margs <- as.list(match.call(definition = sys.function(n - i),
                                   call = sys.call(sys.parent(i))))[-1]
       ex <- eval(substitute(substitute(x, env = ll),
                             env = list(x = ex, ll = margs)))
   }
   `_dat`[eval(ex, envir = `_dat`),]
}

## Works in Hadley's counterexample ...
f()
# [1] 4 4 4 4 4 4 4 4 4 4 4

## ... and in my original test cases.
sub <- function(x, condition) SUBSET(x, condition)
sub2 <- function(AA, BB) sub(AA, BB)

a <- SUBSET(mtcars, cyl == 4)  ## Direct call to SUBSET()
b <- sub(mtcars, cyl == 4)     ## SUBSET() called one level down
c <- sub2(mtcars, cyl == 4)
all(identical(a, b), identical(b, c))
# [1] TRUE

重要提示：请注意，这仍然不是（也不能成为）普遍有用的功能。该函数根本无法知道您希望它在它执行的所有替换中使用哪些符号，因为它在调用堆栈上工作。在许多情况下，用户希望它使用分配给函数体内的符号值，但此函数将始终忽略这些值。

于 2012-10-12T23:19:58.517 回答
1

更新：

这是一个新版本，它解决了两个问题：

a) 以前的版本只是简单地sys.frames()向后遍历。此版本将遵循parent.frames()直到达到.GlobalEnv. 这在例如应该忽略 ' 框架的情况subscramble下很重要。scramble

substituteb) 这个版本每个级别都有一个。这可以防止第二次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

它也适用于subscrambleand 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为xin 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
于 2012-10-16T11:30:38.730 回答