非标准计算

在前面几节中，咱们学习了如何使用 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