子集的编程安全版本 - 在从另一个函数调用时评估其条件

Posted 2023-02-16

【中文标题】子集的编程安全版本 - 在从另一个函数调用时评估其条件

【英文标题】：Programming-safe version of subset - to evaluate its condition while called from another function

【发布时间】：2012-10-02 17:48:47

【问题描述】：

正如subset() 手册所述：

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

我从this great article学到的不仅是这个警告背后的秘密，而且对substitute()、match.call()、eval()、quote()、‍call、promise和其他相关R有很好的理解题目，有点复杂。

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

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

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

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

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

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

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

【问题讨论】：

@BenBolker 你看到下面接受的答案了吗？你认为它不起作用吗？

“伟大的文章”链接指向一个空白的 Wiki 页面。你的意思是this article吗？

【参考方案1】：

[ 函数就是您要寻找的。 ?"["。 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)]

【讨论】：

谢谢贾斯汀，但我不是在寻找函数 sub() 的实现，而是在 sub() 中调用具有相同隐式 with() 的函数子集()。我很想知道在这种情况下是否有解决substitute()-eval() 对的限制。

@AliSharifi 函数为[。这一点在使用data.table 包时尤其明显。查看我的编辑

你错过了重点：我不是在寻找 sub() 的实现。我正在寻找可以通过 sub() 将条件传递给它的子集（）的实现。您在更新的问题中看到了我对子集的实现吗？

@AliSharfi Justin（基本上）是正确的。与subset 做同样事情但“编程安全”的函数是[.data.frame。如果您仔细观察，您会发现它们具有相同的四个参数。

@AliSharifi 你不能同时拥有便利和安全。当您编写函数时，您的工作就是花时间为函数的用户节省时间。使用使用非标准评估的函数进行编程是一个坏主意，因为它们往往会产生极难调试的错误。而且由于您编写了一次函数，但多次调用它，所以最好尽早投入一些额外的时间。

【参考方案2】：

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

它通过在每一步爬上调用堆栈substitute()ing 来最终捕获用户传入的逻辑子集表达式。例如，在下面对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 循环内部构造的一些解释，请参阅Section 6.2，R 语言定义手册的第 6 段。

【讨论】：

虽然这回答了问题，但我认为这是一个危险的功能，因为它比原来的要复杂得多，而且我怀疑在某些设置中容易失败。通常没有办法使使用非标准评估的函数对编程安全 - 这是方便性和安全性之间的权衡。你不能两者兼得。

@AliSharifi：我希望既方便又安全，但我必须同意 Hadley 的观点。您可以使函数更加巴洛克，并让它在更广泛的环境中工作，但仍然会有它失败的极端情况（可能是以一种沉默的、令人讨厌的方式，而不是一个彻底的错误）。我认为在 R 中非常很难/几乎不可能做到这一点——而且我没有足够的 CS 知识来知道是否有人可以设计一种可以做到这一点的语言完全安全且一般...

@JoshO'Brien: 或者叫它..DAT 什么的。如果有人使用..DAT 作为变量名，无论如何他们都是在自找麻烦。

@BenBolker -- 确实如此。我想我刚刚发现了为什么人们如此频繁地使用这种形式的参数名称 (.*)：他们在我之前已经走过了这条路。

顺便说一句，我现在得出的结论是，您的功能是天才，邪恶的天才，但仍然是天才；）

【参考方案3】：

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

Hadley posted a gist 演示了我接受的函数出错的情况。该示例中的扭曲（复制如下）是传递给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

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

【讨论】：

这是否通过@hadley 文章中的subscramble 示例？

@pete -- 不，它没有（尽管我在下面的原始答案 确实 通过了该测试）。令人抓狂的是，当我有更多时间考虑时，我将不得不等待重新审视这个问题，但就目前而言，我认为我的另一个答案是更好的答案。

【参考方案4】：

更新：

这是一个修复了两个问题的新版本：

a) 之前的版本只是简单地向后遍历了sys.frames()。此版本遵循parent.frames()，直到达到.GlobalEnv。这在例如subscramble 中很重要，其中scramble 的框架应该被忽略。

b) 此版本每个级别有一个 substitute。这可以防止第二个 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, ]

这个版本通过了来自 cmets 的 @hadley 的测试：

mtcars $ condition <- 4; subscramble(mtcars, cyl == 4)

很遗憾，以下两个示例现在的行为有所不同：

cyl <- 6; subset(mtcars, cyl==4)
local(cyl <- 6; subset(mtcars, cyl==4))

---

这是对 Josh 的第一个函数的轻微修改。在堆栈中的每一帧，我们先从 x 替换，然后再从帧中替换。这意味着数据框中的符号在每一步都具有优先权。我们可以通过在for 循环中跳过subset 的帧来避免像_dat 这样的伪生成符号。

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 和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 替换call 中的x。但是直接的方法行不通，因为我们想要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

【讨论】：

@hadley：更糟糕的是，类似：mtcars$condition <- sample(c(T, F), nrow(mtcars), repl=T)。在那种情况下，甚至不清楚正确的行为是什么，更不用说如何实现了！

我认为这是尝试修复子集行为的基本问题：您正在许多不同的地方寻找一个符号，并且根据您使用的名称，它的行为会有所不同。非词法作用域使推理函数变得更加困难。