非标准计算

在前面几节中，我们学习了如何使用 quote( ) 和 substitute( ) 将表达式捕获为
语言对象，以及如何使用 eval( ) 在给定列表或环境中计算表达式。这些函数组成
了 R 中元编程的基本功能，这使我们能够调整标准计算。元编程的主要应用是执行非标
准计算以使某些特定用法更容易。接下来的内容中，我们将讨论几个例子，以便对它的
工作方式有一个更好的理解。
1．使用非标准计算快速构建子集
我们经常需要从向量中取出某个子集。子集的范围可能是前几个元素、后几个元素，
或是中间的元素。
前两种情况用 head(x, n) 和 tail(x, n) 很容易解决。第 3 种情况需要输入向量
的长度。
例如，假设有一个整数向量，我们想从中提取第 3 个到倒数第 5 个，这 3 个元素：
x <- 1:10
x[3:(length(x) -5)]
## [1] 3 4 5
上面提取子集的表达式用了两次 x，看起来有些繁琐。我们可以定义一个快速取子集
的函数，使用元编程工具提供一个特殊符号来引用输入向量的长度。下面这个函数 qs( )
是这个想法的简单实现，它允许我们使用点（ . ）来表示输入向量的长度：
qs <- function(x, range) {
range <- substitute(range)
selector <- eval(range, list(. =length(x)))
x[selector]
}
使用这个函数，我们可以用 3:(.-5) 来表示相同的范围：
qs(x, 3:(. -5))
## [1] 3 4 5
也可以通过倒数（逆序）的方式来选取元素：
qs(x, . -1)
## [1] 9
基于 qs( )，下面这个函数用于修剪向量 x 两端的 n 个元素。也就是说，返回剔除
前 n 个和后 n 个元素后的向量 x 的中间部分：
trim_margin <- function(x, n) {
qs(x, (n +1):(. -n -1))
}
这个函数看起来似乎还不错，但是当我们输入一个值调用它时，却发生了错误：
trim_ _margin(x, 3)
## Error in eval(expr, envir, enclos): 找不到对象'n'
为什么会找不到 n 呢？要理解为什么发生这种情况，我们需要分析在调用trim_margin( )
时符号的查找路径。下一节将详细说明这一点，并且介绍动态作用域（ dynamic scoping ）
的概念来解决这个问题。
2．动态作用域
在尝试解决这个问题之前，我们先用之前学到的知识来分析哪里出错了。当调用
trim_margin(x, 3)时，就是在一个新的执行环境里调用 qs(x,(n+1):(.-n-1))，参数
为x 和n。qs( )在这里比较特殊，因为它使用了非标准计算。更具体地说，它首先捕获 range
作为语言对象，然后基于提供的额外符号的列表来对其求值，本例中列表仅包含.=length(x)。
错误就发生在 eval(range,list(.=length(x)))上。此处找不到需要修剪的边
缘元素的数目 n，那一定是封闭环境哪里有问题。现在，我们仔细观察 eval( )函数的
enclos 参数的默认值：
eval
## function (expr, envir = parent.frame(), enclos = if (is.list(envir) ||
## is.pairlist(envir)) parent.frame() else baseenv())
## .Internal(eval(expr, envir, enclos))
## <bytecode: 0x00000000106722c0>
## <environment: namespace:base>
eval( ) 的定义说明，如果我们给 envir 提供一个列表 — 正如前面所做的，
enclos 会默认取 parent.frame( )，而这是 eval( )的调用环境，也就是调用 qs( )
时的执行环境。而 qs( ) 的执行环境中当然没有 n。
这里，我们发现了在 trim_margin( )中使用 substitute( )的一个缺点，因为
表达式只有在正确的语境下才是完全有意义的，即 trim_margin( )的执行环境，同时
也是 qs( )的调用环境。不幸的是，substitute( )只捕获表达式，而不捕获使表达式
有意义的环境。因此，我们必须自己完成这一步。
现在，知道了问题所在。解决办法很简单，就是始终使用正确的封闭环境，即定义被捕获
的表达式的环境。在本例中，我们指定 enclos = parent.frame( )，以便 eval( )在提
供了n 的qs( )的调用环境（即trim_margin( )的执行环境）查找除了 . 以外的所有符号。
下面这行代码是 qs( )的修改版本：
qs <- function(x, range) {
range <- substitute(range)
selector <- eval(range, list(. =length(x)), parent.frame())
x[selector]
}
使用之前报错的代码重新测试该函数：
trim_ _margin(x, 3)
## [1] 4 5 6
现在，该函数能够用正确的方式运行了。事实上，这个机制就是动态作用域。回想一
下上一章学到的知识：每次调用函数时都会创建一个执行环境。如果一个符号在执行环境
中找不到，就会去封闭环境中搜索。
根据在标准计算中用到的词法作用域机制，函数的封闭环境在函数被定义时就已确定，
并且定义函数的环境也被确定。
然而，与之相反的是，根据非标准计算用到的动态作用域机制，封闭环境应是调用环
境，在这个调用环境中定义了被捕获的表达式，这样就可以在自定义的执行环境或封闭环
境及其父环境中找到相关符号。
总之，当一个函数使用非标准计算时，正确实现动态作用域机制是很重要的。
3．使用公式来捕获表达式和环境
为了正确实现动态作用域机制，我们使用 parent.frame( )来追踪 substitute( )
捕获的表达式。一个更简单的办法是用公式同时捕获表达式和环境。
在第 7 章中，我们看到公式经常被用来表示变量之间的关系。大多数模型函数（如lm( )）
接收一个公式来指定响应变量和解释变量之间的关系。
实际上，公式对象比这简单得多。它会自动捕获 ~ 符号两边的表达式以及创建它的环
境。例如，我们可以直接创建一个公式并存储在一个变量中：
formula1 <- z ~ x ^2 + y ^2
可以看到公式本质上是属于 formula 类的语言对象：
typeof(formula1)
## [1] "language"
class(formula1)
## [1] "formula"
如果我们将公式转换为列表，就可以仔细查看它的结构：
str(as.list(formula1))
## List of 3
## $ : symbol ~
## $ : symbol z
## $ : language x^2 + y^2
## - attr(*, "class")= chr "formula"
## - attr(*, ".Environment")=< environment: R_GlobalEnv>
可以看到formula1不仅将 ~ 两侧的表达式捕获为语言对象，还捕获了创建它的环境。
实际上，公式就只是一个基于被捕获的参数和调用环境的函数（ ~ ）调用。如果指定了 ~ 的
两侧，调用的长度便为 3 ：
is.call(formula1)
## [1] TRUE
length(formula1)
## [1] 3
要访问被捕获的语言对象，我们可以提取第 2 个和第 3 个元素：
formula1[[2]]
## z
formula1[[3]]
## x^2 + y^2
要访问创建该调用的环境，可以使用 environment( )：
environment(formula1)
## <environment: R_GlobalEnv>
公式也可以是右侧型的，即只指定 ~ 的右边。示例如下：
formula2 <- ~x +y
str(as.list(formula2))
## List of 2
## $ : symbol ~
## $ : language x + y
## - attr(*, "class")= chr "formula"
## - attr(*, ".Environment")=<environment: R_GlobalEnv>
本例中，我们只提供并捕获了 ~ 的一个参数，所以有一个包含两个语言对象的调用，
可以通过提取第 2 个元素来访问被捕获表达式：
length(formula2)
## [1] 2
formula2[[2]]
## x + y
了解了公式如何工作之后，就可以用公式实现qs( )和trim_margin( )的另一个版本。
当 range 是一个公式时，下面这个函数 qs2( )与 qs( )的运行方式一致；否则它就
直接用 range 来提取 x 的子集：
qs2 <- function(x, range) {
selector <- if (inherits(range, "formula")) {
eval(range[[2]], list(. =length(x)), environment(range))
} else range
x[selector]
}
注意到，我们使用 inherits(range, "formula")检查 range 是不是一个公式，并
且用 environment (range)实现动态作用域。然后，用一个右侧型公式来激活非标准计算：
qs2(1:10, ~3:(. -2))
## [1] 3 4 5 6 7 8
或者，也可以使用标准计算：
qs2(1:10, 3)
## [1] 3
现在，我们可以借助使用公式的 qs2( )来重新实现 trim_margin( )：
trim_margin2 <- function(x, n) {
qs2(x, ~ (n +1):(. -n -1))
}
可以验证，动态作用域机制正常运作，因为 trim_margin2( )中使用的公式自动捕
获执行环境（也是定义公式和 n 的环境）：
trim_ _margin2(x, 3)
## [1] 4 5 6
4．使用元编程构建子集
了解了语言对象、求值函数和动态作用域机制后，我们现在就可以实现 subset 的另
一种版本。
这个实现的基本想法很简单：
• 捕获行构建子集表达式，并在数据框内对其求值，数据框本质上是一个列表；
• 捕获按列选取的表达式，并在整数索引的命名列表中对其求值；
• 使用行选择器（逻辑向量）和列选择器（整数向量）对数据框选取子集。
这里给出上述逻辑的一种实现：
subset2 <- function(x, subset =TRUE, select =TRUE) {
enclos <- parent.frame()
subset <- substitute(subset)
select <- substitute(select)
row_selector <- eval(subset, x, enclos)
col_envir <- as.list(seq_ _along(x))
names(col_envir) <- colnames(x)
col_selector <- eval(select, col_envir, enclos)
x[row_selector, col_selector]
}
按行构建子集要比按列更容易实现。要执行按行构建子集，我们只需要捕获 subset
并在数据框内对其求值即可。
按列构建子集则比较棘手，要给列创建一个整数索引列表，并给它们赋予相应的名称。
例如，一个具有 3 列（如 x，y，z）的数据框需要这样一个索引列表：list(a = 1, b = 2,
c = 3)，这使我们能够以 select = c(x, y) 的形式选取列，因为 c(x, y) 是在列表
内被计算的。
现在，subset2( ) 的运行方式就非常接近内置函数 subset( ) 了：
subset2(mtcars, mpg >= quantile(mpg, 0.9), c(mpg, cyl, qsec))
## mpg cyl qsec
## Fiat 128 32.4 4 19.47
## Honda Civic 30.4 4 18.52
## Toyota Corolla 33.9 4 19.90
## Lotus Europa 30.4 4 16.90
两种实现都允许我们用 a:b 来选取 a 和 b 之间的所有列，包括 a 和 b：
subset2(mtcars, mpg >= quantile(mpg, 0.9), mpg:drat)
## mpg cyl disp hp drat
## Fiat 128 32.4 4 78.7 66 4.08
## Honda Civic 30.4 4 75.7 52 4.93
## Toyota Corolla 33.9 4 71.1 65 4.22
## Lotus Europa 30.4 4 95.1 113 3.77