call函数

call函数构建一个命令（function call），其第一个参数必须是一个字符串，指明需要被构建的命令，其余参数都会被传递给新生成的命令。

cl <- call("round",1.11)
cl

## round(1.11)

## round(1.11)
class(cl);typeof(cl)

## [1] "call"

## [1] "language"

## [1] "call"
## [1] "language"
identical(cl,quote(round(1.11)))

## [1] TRUE

## [1] TRUE
is.call(cl) && is.language(cl)

## [1] TRUE

## [1] TRUE
eval(cl)

## [1] 1

## [1] 1
(cl_list <- as.list(cl))

## [[1]]
## round
## 
## [[2]]
## [1] 1.11

## [[1]]
## round
## 
## [[2]]
## [1] 1.11
as.call(cl_list)

## round(1.11)

## round(1.11)
mode(cl_list) <- "call";cl_list

## round(1.11)

## round(1.11)

do.call(what, args, quote = FALSE, envir = parent.frame())命令则是直接在envir中执行call命令。

捕获代码

quote(expr)函数捕获未执行的代码。enquote(cl)捕获代码的运行结果,cl为call对象。

quote(1:9 + 2)

## 1:9 + 2

## 1:9 + 2
enquote(1:9 + 2)

## base::quote(c(3, 4, 5, 6, 7, 8, 9, 10, 11))

## base::quote(c(3, 4, 5, 6, 7, 8, 9, 10, 11))

如果希望捕获代码中，某些变量名被替换为对应的值，可以使用substitute(expr, env),substitute函数除了需要捕获的代码，还可以传递一个替换环境env（可以是列表、数据框、执行环境等）参数，此时代码中的变量名如果在env中有对应的值，则会被替换为相应的值，除非env是全局执行环境。

如果只希望特定的变量名可以被替换，而非所有在执行环境中存在的变量都会被替换，则可以使用bquote函数，该函数定义了一种特殊的语法格式——所有被包含在.()中的变量名才会被替换。

substitute(a + b, list(b = 1))

## a + 1

## a + 1
substitute(a + b, baseenv())

## .Primitive("+")(a, b)

## .Primitive("+")(a, b)
b <- 1;substitute(a + b, globalenv())

## a + b

## a + b
bquote(x <- .(x) + 1, list(x = 1:9))

## x <- 1:9 + 1

## x <- 1:9 + 1

由操作符~构成的命令，被捕获或执行后结果是一致的，唯一的区别在于～被捕获后产生的结果没有属性（attributes）部分，但无论何种情况我们可以像操作命令树一样取出~前后的内容，所以~经常被用作捕获代码的便捷操作符号。

str(eval(y~x))

## Class 'formula'  language y ~ x
##   ..- attr(*, ".Environment")=<environment: R_GlobalEnv>

## Class 'formula'  language y ~ x
##   ..- attr(*, ".Environment")=<environment: R_GlobalEnv>
str(quote(y~x))

##  language y ~ x

##  language y ~ x
f <- y~x+z
class(f);typeof(f)

## [1] "formula"

## [1] "language"

## [1] "formula"
## [1] "language"
terms(f)

## y ~ x + z
## attr(,"variables")
## list(y, x, z)
## attr(,"factors")
##   x z
## y 0 0
## x 1 0
## z 0 1
## attr(,"term.labels")
## [1] "x" "z"
## attr(,"order")
## [1] 1 1
## attr(,"intercept")
## [1] 1
## attr(,"response")
## [1] 1
## attr(,".Environment")
## <environment: R_GlobalEnv>

## y ~ x + z
## attr(,"variables")
## list(y, x, z)
## attr(,"factors")
##   x z
## y 0 0
## x 1 0
## z 0 1
## attr(,"term.labels")
## [1] "x" "z"
## attr(,"order")
## [1] 1 1
## attr(,"intercept")
## [1] 1
## attr(,"response")
## [1] 1
## attr(,".Environment")
## <environment: R_GlobalEnv>

terms可以用于提取公式的信息，更具体的，可以?formula

命令集（expression）本身就是未被执行的命令的集合，所以被捕获之后生成的是一个生成该命令集的命令，需要被执行两次才能取出执行结果。

#一个表达式向量
(ex <- expression(x = 1, 1 + sqrt(2)))

## expression(x = 1, 1 + sqrt(2))

## expression(x = 1, 1 + sqrt(2))
length(ex);ex[2];typeof(ex[1])

## [1] 2

## expression(1 + sqrt(2))

## [1] "expression"

## [1] 2
## expression(1 + sqrt(2))
## [1] "expression"
as.list(ex)

## $x
## [1] 1
## 
## [[2]]
## 1 + sqrt(2)

## $x
## [1] 1
## 
## [[2]]
## 1 + sqrt(2)
lapply(ex,eval)

## $x
## [1] 1
## 
## [[2]]
## [1] 2.414214

## $x
## [1] 1
## 
## [[2]]
## [1] 2.414214

eval执行代码

eval(expr, envir, enclos)执行捕获的代码，其中envir是代码中变量名的首要查找位置，envir中查找不到的变量名会在enclos中查找。

在指定的环境中计算R表达式。

# #在指定的环境中计算R表达式
# eval(1+1,envir = globalenv())
# ## [1] 2
# #local函数默认情况下会在一个临时执行环境中执行代码，可以有效的舍弃运算过程中产生的中间变量，返回最后一行表达式，类似函数。
# local({
#   a <- 1:9;
#   b <- a
# },envir = new.env())
# a;b
# ## Error in eval(expr, envir, enclos): object 'a' not found
# ## [1] 1

可以看到a变量并不在调用环境中。

表达式解析parse与deparse

(ex <- parse(text = "local({a <- 1;1})"))

## expression(local({
##     a <- 1
##     1
## }))

## expression(local({
##     a <- 1
##     1
## }))
deparse(quote(x <- 1))

## [1] "x <- 1"

## [1] "x <- 1"
deparse(ex[1])

## [1] "expression(local({" "    a <- 1"         "    1"             
## [4] "}))"

## [1] "expression(local({" "    a <- 1"         "    1"             
## [4] "}))"
deparse(args(lm))

## [1] "function (formula, data, subset, weights, na.action, method = \"qr\", " 
## [2] "    model = TRUE, x = FALSE, y = FALSE, qr = TRUE, singular.ok = TRUE, "
## [3] "    contrasts = NULL, offset, ...) "                                    
## [4] "NULL"

## [1] "function (formula, data, subset, weights, na.action, method = \"qr\", " 
## [2] "    model = TRUE, x = FALSE, y = FALSE, qr = TRUE, singular.ok = TRUE, "
## [3] "    contrasts = NULL, offset, ...) "                                    
## [4] "NULL"

总体而已，base R这些函数关系大概如下：

knitr::include_graphics("./images/rmetaprogramming.svg")

捕获表达式

类似quote,rlang使用expr(expr)捕获代码：

library(tidyverse)

## ── Attaching packages ─────────────────────────────────────── tidyverse 1.3.1 ──

## ✓ ggplot2 3.3.3     ✓ purrr   0.3.4
## ✓ tibble  3.1.1     ✓ dplyr   1.0.5
## ✓ tidyr   1.1.3     ✓ stringr 1.4.0
## ✓ readr   1.4.0     ✓ forcats 0.5.1

## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## x purrr::%@%()         masks rlang::%@%()
## x purrr::as_function() masks rlang::as_function()
## x dplyr::filter()      masks stats::filter()
## x purrr::flatten()     masks rlang::flatten()
## x purrr::flatten_chr() masks rlang::flatten_chr()
## x purrr::flatten_dbl() masks rlang::flatten_dbl()
## x purrr::flatten_int() masks rlang::flatten_int()
## x purrr::flatten_lgl() masks rlang::flatten_lgl()
## x purrr::flatten_raw() masks rlang::flatten_raw()
## x purrr::invoke()      masks rlang::invoke()
## x dplyr::lag()         masks stats::lag()
## x purrr::list_along()  masks rlang::list_along()
## x purrr::modify()      masks rlang::modify()
## x purrr::prepend()     masks rlang::prepend()
## x purrr::splice()      masks rlang::splice()

expr(mean(x, na.rm = TRUE))

## mean(x, na.rm = TRUE)

## mean(x, na.rm = TRUE)
expr(10 + 100 + 1000)

## 10 + 100 + 1000

## 10 + 100 + 1000

expr能捕获键入的代码，但是没法捕获传递给函数参数的代码，所以rlang提供了enexpr函数：enexpr()接受一个惰性求值（被冻结的，promise??）的参数并将其转换为一个表达式:

capture_it <- function(x) {
  expr(x)
}
capture_it(a + b + c)

## x

## x

capture_it <- function(x) {
  enexpr(x)
}
capture_it(a + b + c)

## a + b + c

## a + b + c

类似地，substitute()可以完成enexpr的工作：

capture_it <- function(x) {
  substitute(x)
}
capture_it(a + b + c)

## a + b + c

## a + b + c

生成表达式

几乎每种编程语言都将代码表示为一棵树，通常称为抽象语法树，简称 AST。在R中，可以通过lobstr::ast(x)查看代码树。

lobstr::ast(f1(f2(a = 1+2*3, b), f3(1, f4(2))))

## █─f1 
## ├─█─f2 
## │ ├─a = █─`+` 
## │ │     ├─1 
## │ │     └─█─`*` 
## │ │       ├─2 
## │ │       └─3 
## │ └─b 
## └─█─f3 
##   ├─1 
##   └─█─f4 
##     └─2

## █─f1 
## ├─█─f2 
## │ ├─a = █─`+` 
## │ │     ├─1 
## │ │     └─█─`*` 
## │ │       ├─2 
## │ │       └─3 
## │ └─b 
## └─█─f3 
##   ├─1 
##   └─█─f4 
##     └─2

在base R中提供call函数生成代码，而rlang则使用call2和unquoting。

rlang::call2("+", 1, call2("*", 2, 3))

## 1 + 2 * 3

## 1 + 2 * 3

rlang使用unquote操作符!!(发音为bang bang)可以将存储的代码树插入被捕获表达式中：

xx <- expr(x + x)
yy <- expr(y + y)

expr(!!xx / !!yy)

## (x + x)/(y + y)

## (x + x)/(y + y)
cv <- function(var) {
  var <- enexpr(var)
  expr(sd(!!var) / mean(!!var))
}

cv(x + y)

## sd(x + y)/mean(x + y)

## sd(x + y)/mean(x + y)

多个表达式使用!!!

xs <- exprs(1, a, -b)
expr(f(!!!xs, y))

## f(1, a, -b, y)

## f(1, a, -b, y)

评估（Evaluation）代码

eval_tidy(expr,data = NULL,env = caller_env)是eval的一种变体，其使用as_data_mask函数增加了一层数据掩码，eval_tidy的data参数中的对象优先于调用环境中的对象。

Advanced R展示了一个例子，用于解释使用数据掩码时必须始终使用enquo()而不是enexpr()。

with2 <- function(df, expr) {
  a <- 1000
  eval_tidy(enexpr(expr), df)
}
df <- data.frame(x = 1:3)
a <- 10
with2(df, x + a)

## [1] 1001 1002 1003

## [1] 1001 1002 1003

可以看到捕获到的表达式中a变量的值为1000，而不是全局变量中的10，而rlang 使用一种新的数据结构解决这个问题: 将表达式与环境捆绑在一起的quosure。

with2 <- function(df, expr) {
  a <- 1000
  eval_tidy(enquo(expr), df)
}

with2(df, x + a)

## [1] 11 12 13

## [1] 11 12 13

可以看到a变量绑定到了定义了x+a的表达式环境中去了。

解析表达式

parse_expr(x)可以解析字符串为表达式，类似与parse,而expr_text 则类似deparse

chr <- "y <- x + 10"
(z <- parse_expr(chr))

## y <- x + 10

## y <- x + 10
expr_text(z)

## [1] "y <- x + 10"

## [1] "y <- x + 10"

parse_exprs(x)用于多个表达式,返回一个表达式list,类似于as.list(parse(...))

path <- tempfile("my-file.R")
# tempfile returns a vector of character strings which can be used as names for temporary files.
cat("1; 2; mtcars", file = path)
parse_exprs(file(path))

## [[1]]
## [1] 1
## 
## [[2]]
## [1] 2
## 
## [[3]]
## mtcars

## [[1]]
## [1] 1
## 
## [[2]]
## [1] 2
## 
## [[3]]
## mtcars

e2 = "vs + am ; am +vs";
mtcars %>% mutate(!!!parse_exprs(e2))

##                      mpg cyl  disp  hp drat    wt  qsec vs am gear carb vs + am
## Mazda RX4           21.0   6 160.0 110 3.90 2.620 16.46  0  1    4    4       1
## Mazda RX4 Wag       21.0   6 160.0 110 3.90 2.875 17.02  0  1    4    4       1
## Datsun 710          22.8   4 108.0  93 3.85 2.320 18.61  1  1    4    1       2
## Hornet 4 Drive      21.4   6 258.0 110 3.08 3.215 19.44  1  0    3    1       1
## Hornet Sportabout   18.7   8 360.0 175 3.15 3.440 17.02  0  0    3    2       0
## Valiant             18.1   6 225.0 105 2.76 3.460 20.22  1  0    3    1       1
## Duster 360          14.3   8 360.0 245 3.21 3.570 15.84  0  0    3    4       0
## Merc 240D           24.4   4 146.7  62 3.69 3.190 20.00  1  0    4    2       1
## Merc 230            22.8   4 140.8  95 3.92 3.150 22.90  1  0    4    2       1
## Merc 280            19.2   6 167.6 123 3.92 3.440 18.30  1  0    4    4       1
## Merc 280C           17.8   6 167.6 123 3.92 3.440 18.90  1  0    4    4       1
## Merc 450SE          16.4   8 275.8 180 3.07 4.070 17.40  0  0    3    3       0
## Merc 450SL          17.3   8 275.8 180 3.07 3.730 17.60  0  0    3    3       0
## Merc 450SLC         15.2   8 275.8 180 3.07 3.780 18.00  0  0    3    3       0
## Cadillac Fleetwood  10.4   8 472.0 205 2.93 5.250 17.98  0  0    3    4       0
## Lincoln Continental 10.4   8 460.0 215 3.00 5.424 17.82  0  0    3    4       0
## Chrysler Imperial   14.7   8 440.0 230 3.23 5.345 17.42  0  0    3    4       0
## Fiat 128            32.4   4  78.7  66 4.08 2.200 19.47  1  1    4    1       2
## Honda Civic         30.4   4  75.7  52 4.93 1.615 18.52  1  1    4    2       2
## Toyota Corolla      33.9   4  71.1  65 4.22 1.835 19.90  1  1    4    1       2
## Toyota Corona       21.5   4 120.1  97 3.70 2.465 20.01  1  0    3    1       1
## Dodge Challenger    15.5   8 318.0 150 2.76 3.520 16.87  0  0    3    2       0
## AMC Javelin         15.2   8 304.0 150 3.15 3.435 17.30  0  0    3    2       0
## Camaro Z28          13.3   8 350.0 245 3.73 3.840 15.41  0  0    3    4       0
## Pontiac Firebird    19.2   8 400.0 175 3.08 3.845 17.05  0  0    3    2       0
## Fiat X1-9           27.3   4  79.0  66 4.08 1.935 18.90  1  1    4    1       2
## Porsche 914-2       26.0   4 120.3  91 4.43 2.140 16.70  0  1    5    2       1
## Lotus Europa        30.4   4  95.1 113 3.77 1.513 16.90  1  1    5    2       2
## Ford Pantera L      15.8   8 351.0 264 4.22 3.170 14.50  0  1    5    4       1
## Ferrari Dino        19.7   6 145.0 175 3.62 2.770 15.50  0  1    5    6       1
## Maserati Bora       15.0   8 301.0 335 3.54 3.570 14.60  0  1    5    8       1
## Volvo 142E          21.4   4 121.0 109 4.11 2.780 18.60  1  1    4    2       2
##                     am + vs
## Mazda RX4                 1
## Mazda RX4 Wag             1
## Datsun 710                2
## Hornet 4 Drive            1
## Hornet Sportabout         0
## Valiant                   1
## Duster 360                0
## Merc 240D                 1
## Merc 230                  1
## Merc 280                  1
## Merc 280C                 1
## Merc 450SE                0
## Merc 450SL                0
## Merc 450SLC               0
## Cadillac Fleetwood        0
## Lincoln Continental       0
## Chrysler Imperial         0
## Fiat 128                  2
## Honda Civic               2
## Toyota Corolla            2
## Toyota Corona             1
## Dodge Challenger          0
## AMC Javelin               0
## Camaro Z28                0
## Pontiac Firebird          0
## Fiat X1-9                 2
## Porsche 914-2             1
## Lotus Europa              2
## Ford Pantera L            1
## Ferrari Dino              1
## Maserati Bora             1
## Volvo 142E                2

总共可以分为三步

捕获表达式：将表达式本身存储为变量的形式，防止表达式的直接执行(执行了还修改什么)；使用函数quote()

修改表达式：当一个表达式被捕获为调用对象后，可以将其当作列表来修改

执行表达式：捕获表达式后，下一步就是对其求值，可使用eval()函数

R 变量名称和字符串的转换

使用assign 和 get函数

get()：返回与字符串同名的变量的值 assign():为字符串变量的字符串赋值

The get function searches and calls a data object. The assign R function assigns values to a variable name.

这和上面的不一样，这个只是在变量名和字符串之间转换，上面的是字符串和整个命令之间的转换

get R Function (5 Example Codes) | Call Vector or Column of Data Frame (statisticsglobe.com)

assign Function in R (2 Examples) | How to Store Values in Variable Name (statisticsglobe.com)

强制运算符(Forcing operators)(!!及!!!)

大家熟知的!符号的作用可能都是逻辑运算，用来表示否定的逻辑。但实际上它们还有另一个作用，就是Forcing operators。Forcing operators一共有两种，!!是bang-bang operator，!!!是big-bang operator。如果我们在Rstudio的帮助功能中搜索!!，就会查到这两个运算符的解释：

The bang-bang operator !! forces a single object. One common case for !! is to substitute an environment-variable (created with <-) with a data-variable (inside a data frame).

The big-bang operator !!! forces-splice a list of objects. The elements of the list are spliced in place, meaning that they each become one single argument. 我查了半天都没查到这两个运算符到底要怎么翻译，音译跟意译都挺搞笑的…就姑且统称强制运算符吧。

sym把一个R字符串对象转换为一个symbol。 (bang-bang操作符)!!则把symbol再转回R字符串对象，等同于直接写这个对象。

library(dplyr)
library(tidyverse)
library(rlang)

We need some way to explicitly unquote the input to tell cement() to remove the automatic quote marks. Here we need time and name to be treated differently to Good. Quasiquotation (准报价) gives us a standard tool to do so: !!, called “unquote”, and pronounced bang-bang. !! tells a quoting function to drop the implicit (内含的) quotes:

name <- "Hadley"
time <- "morning"

paste("Good", time, name)

## [1] "Good morning Hadley"

cement <- function(...) {
  args <- ensyms(...)
  paste(purrr::map(args, as_string), collapse = " ")
}


cement(Good, time, name)

## [1] "Good time name"

cement() quotes its arguments, so we must unquote where needed.

cement(Good, !!time, !!name)

## [1] "Good morning Hadley"

!! is a one-to-one replacement. !!! (called “unquote-splice”, and pronounced bang-bang-bang) is a one-to-many replacement. It takes a list of expressions and inserts them at the location of the !!!:

xs <- exprs(1, a, -b)
expr(f(!!!xs, y))

## f(1, a, -b, y)

df <- data.frame(A=1:5, B=(1:5)*2)

library(dplyr)
df %>% select(A,B)

##   A  B
## 1 1  2
## 2 2  4
## 3 3  6
## 4 4  8
## 5 5 10

df %>% select("A", "B")

##   A  B
## 1 1  2
## 2 2  4
## 3 3  6
## 4 4  8
## 5 5 10

# 等同于
columns <- c("A","B")
columns_en <- syms(columns)
df %>% select(!!!columns_en)

##   A  B
## 1 1  2
## 2 2  4
## 3 3  6
## 4 4  8
## 5 5 10

df %>% select(columns)

## Note: Using an external vector in selections is ambiguous.
## ℹ Use `all_of(columns)` instead of `columns` to silence this message.
## ℹ See <https://tidyselect.r-lib.org/reference/faq-external-vector.html>.
## This message is displayed once per session.

##   A  B
## 1 1  2
## 2 2  4
## 3 3  6
## 4 4  8
## 5 5 10

dfs <- list(
  a = data.frame(x = 1, y = 2),
  b = data.frame(x = 3, y = 4)
)

dfs

## $a
##   x y
## 1 1 2
## 
## $b
##   x y
## 1 3 4

bind_rows(!!!dfs)

##   x y
## 1 1 2
## 2 3 4

test_df <- tibble(a = 1, b = 1, c = 1, d = 1)

test_df %>%
  select(1, 2, 3)

## # A tibble: 1 x 3
##       a     b     c
##   <dbl> <dbl> <dbl>
## 1     1     1     1

our_list <- list(1, 2, 3)

# test_df %>% select(our_list) 这样不行

test_df %>% select(c(1, 2, 3)) # 这样可以

## # A tibble: 1 x 3
##       a     b     c
##   <dbl> <dbl> <dbl>
## 1     1     1     1

# This code
test_df %>%
  select(!!!our_list)

## # A tibble: 1 x 3
##       a     b     c
##   <dbl> <dbl> <dbl>
## 1     1     1     1

# Translates to this
test_df %>%
  select(1, 2, 3)

## # A tibble: 1 x 3
##       a     b     c
##   <dbl> <dbl> <dbl>
## 1     1     1     1