非标准求值 — 数据科学中的 R 语言

编写函数

R

library(tidyverse)
library(rlang)

写代码的过程中，我们会遇到对不同的数据框，执行相同的操作。比如

R

df1 %>% group_by(x1) %>% summarise(mean = mean(y1))
df2 %>% group_by(x2) %>% summarise(mean = mean(y2))
df3 %>% group_by(x3) %>% summarise(mean = mean(y3))
df4 %>% group_by(x4) %>% summarise(mean = mean(y4))

为了减少代码的重复，我们考虑将共同的部分保留，变化的部分用参数名提取出来

R

data %>% group_by(group_var) %>% summarise(mean = mean(summary_var))

很自然地，我们想到写一个子函数的形式，比如

R

grouped_mean <- function(data, group_var, summary_var) {
  data %>%
    group_by(group_var) %>%
    summarise(mean = mean(summary_var))
}

当我们试图运行这段代码的时候，却发现报错了

R

grouped_mean(mtcars, cyl, mpg)

Hadley Wickham告诉我们，正确的写法应该是，

R

grouped_mean <- function(data, group_var, summary_var) {
  group_var <- enquo(group_var)
  summary_var <- enquo(summary_var)

  data %>%
    group_by(!!group_var) %>%
    summarise(mean = mean(!!summary_var))
}

然后再运行

R

grouped_mean(mtcars, cyl, mpg)

或者更简便的

R

grouped_mean <- function(data, group_var, summary_var) {
  data %>%
    group_by({{group_var}}) %>%
    summarise(mean = mean({{summary_var}}))
}

grouped_mean(mtcars, cyl, mpg)

dplyr1.0之后，可以这样写

R

sum_group_vars <- function(df, 
                           group_vars, 
                           sum_vars){
  df %>% 
    group_by(across({{ group_vars }})) %>% 
    summarise(n = n(), 
              across({{ sum_vars }}, 
                     list(mean = mean, sd = sd))
              )
}

sum_group_vars(mpg, c(model, year), c(hwy, cty))

下面我们讲讲为什么要这样写。

看看发生了什么

弄清楚之前，这里需要明白两个概念：

环境变量(env-variables) ，一般你在Rstuido右上角的Environment中发现它。比如 n <- 10这里的n
数据变量(data-variables)，一般指数据框的某个变量。比如data <- data.frame(x = 1, n = 2)中的data$n

那么，对于我们这里编写的函数中

R

grouped_mean(mtcars, cyl, mpg)

cyl和mpg是打算传递的参数，是环境变量，但我们期望他们在函数中当作mtcars中的数据变量，即当做mtcars的一个列的名字来使用，那么要完成这个角色转换，就需要引用(quote)和解引用(unquote)两个工序：

第一步，用 enquo()把用户传递过来的参数引用起来（引用可以理解为冷冻起来）
第二步，用 !! 解开这个引用（解引用可以理解为解冷），然后使用参数的内容

这个quote-unquote的过程让环境变量名变成了数据变量，也可以理解为在函数评估过程中，数据变量（data-variable）遮盖了环境变量（env-variable），即数据遮盖（data masking），看到cyl，正常情况下，本来应该是到环境变量里去找这个cyl对应的值，然而，数据遮盖机制，插队了，让代码去数据变量中去找cyl以及对应的值。

我们通过rlang::qq_show()看看这个quote-unquote机制是怎么工作的

先看看qq_show()

R

var <- quote(height)
qq_show(!!var)

再看看grouped_mean()的代码

R

group_var <-  quote(cyl)
summary_var <-  quote(mpg)
	
rlang::qq_show( 
	data %>%
    group_by(!!group_var) %>%
    summarise(mean = mean(!!summary_var))
)

关于数据遮盖更多细节请看Quote and unquote。

处理多个参数

前面讲了如何传递分组参数和统计参数到子函数。如果传递更多的参数，可以用...代替group_var ，然后传递到group_by()，比如

R

grouped_mean <- function(data, summary_var, ...) {
  summary_var <- enquo(summary_var)
    group_var <- enquos(...)
 
  data %>%
    group_by(!!!group_var) %>%
    summarise(mean = mean(!!summary_var))
}

指定统计参数disp，分组参数(cyl am)，然后运行代码,

R

grouped_mean(mtcars, disp, cyl, am)

或者指定统计参数disp，更多的分组参数(cyl, am, vs)

R

grouped_mean(mtcars, disp, cyl, am, vs)

注意到...代表的是多个参数，因此在引用的时候用的是enquos()，在解引用的时候用的是group_by(!!!group_var). 事实上, ...是一个特殊的符号，我们可以省略引用后再解引用的过程，直接传给给group_by()，比如

R

grouped_mean <- function(data, summary_var, ...) {
  summary_var <- enquo(summary_var)

  data %>%
    group_by(...) %>%
    summarise(mean = mean(!!summary_var))
}

grouped_mean(mtcars, disp, cyl, am, vs)

调整输入的表达式

修改引用参数的默认名

我们希望输出的统计结果中，统计参数名加一个前缀 "avg_"，可以分三步完成

获取引用参数的默认名
修改参数的默认名，比如加前缀或者后缀
!! 解引用并放在 := 左边

R

grouped_mean2 <- function(.data, .summary_var, ...) {
  summary_var <- enquo(.summary_var)
  group_vars <- enquos(...)

  # Get and modify the default name
  summary_nm <- as_label(summary_var)
  summary_nm <- paste0("avg_", summary_nm)

  .data %>%
    group_by(!!!group_vars) %>%
    summarise(!!summary_nm := mean(!!summary_var))  # Unquote the name
}

grouped_mean2(mtcars, disp, cyl, am)

或者更简洁的办法

R

my_summarise <- function(data, group_var, summarise_var) {
  data %>%
    group_by(across({{ group_var }})) %>%
    summarise(across({{ summarise_var }}, mean, .names = "mean_{col}"))
}

my_summarise(starwars, species, height)

如果想调整多个分组变量的默认名，比如加个前缀"groups_"，方法和上面的步骤类似

引用传递过来的参数名，.enquos(..., .named = TRUE), 增加了控制语句.named = TRUE
修改在每个参数的默认名，比如加前缀或者后缀
!! 解引用并放在 := 左边

R

grouped_mean3 <- function(.data, .summary_var, ...) {
  summary_var <- enquo(.summary_var)

  # Quote the dots with default names
  group_vars <- enquos(..., .named = TRUE)

  summary_nm <- as_label(summary_var)
  summary_nm <- paste0("avg_", summary_nm)

  # Modify the names of the list of quoted dots
  names(group_vars) <- paste0("groups_", names(group_vars))

  .data %>%
    group_by(!!!group_vars) %>%  # Unquote-splice as usual
    summarise(!!summary_nm := mean(!!summary_var))
}

grouped_mean3(mtcars, disp, cyl, am)

修改引用的表达式

有时候，我们不想“按多个变量分组，对一个变量统计”。而是“按一个变量分组，对多个变量统计”。这种情况，我们就需要调整引用的表达式

.group_var放分组的变量species
... 放需要统计的多个变量height, mass，期望完成 mean(height), mean(mass)
需要用purrr:map()配合调整表达式，如

R

vars <- list(quote(mass), quote(height))

purrr::map(vars, function(var) expr(mean(!!var, na.rm = TRUE)))

完整代码可以这样写

R

grouped_mean4 <- function(.data, .group_var, ...) {
  group_var <- enquo(.group_var)
  summary_vars <- enquos(..., .named = TRUE)

  # Wrap the summary variables with mean()
  summary_vars <- purrr::map(summary_vars, function(var) {
    expr(mean(!!var, na.rm = TRUE))
  })

  # Prefix the names with `avg_`
  names(summary_vars) <- paste0("avg_", names(summary_vars))

  .data %>%
    group_by(!!group_var) %>%
    summarise(!!!summary_vars)
}

R

grouped_mean4(starwars, species, height, mass)

案例

统计并过滤

R

df <- tibble(index = sample(letters[1:4], size = 100, replace = TRUE) ) 
df

R

filter_which <- function(df, var, val) {
	
	which_var <- enquo(var)
	which_val <- as_name(enquo(val))
	
	df %>% 
		count(!!which_var) %>% 
		filter(!!which_var ==  which_val) 
	
}


df %>% 
	filter_which(index, a)

自定义统计输出

R

my_summarise <- function(data, expr) {
  data %>% summarise(
    "mean_{{expr}}" := mean({{ expr }}),
    "sum_{{expr}}" := sum({{ expr }}),
    "n_{{expr}}" := n()
  )
}

mtcars %>% my_summarise(mpg)

形成依次下滑的列

R

d <- tibble(x = seq_len(10))


jetlag <- function(data, variable, n = 10){
  variable <- enquo(variable)
  
  indices <- seq_len(n)
  quosures <- purrr::map( indices, ~quo(lag(!!variable, !!.x)) ) %>%
      purrr::set_names(nm = purrr::map_chr(indices, ~paste0("lag_", .x)))
  
  dplyr::mutate(data, !!!quosures)
  
}


d %>% jetlag(x, 3)

可能会用到的函数

enquo() vs quo() vs expr() vs as_name() vs as_label() vs sym()

R

a <- 1
b <- 1
var <- quote(a + b)
# returns a single quoted expression for the delayed computation
var

R

qq_show(!!var)

R

# quotes a new expression locally
expr(mean(!!var, na.rm = TRUE))

R

var <- quo(height)

# transforms a quoted variable name into a string. 
as_name(var)

R

# also returns a single string but supports any kind of R object as input, including quoted function calls and vectors. Its purpose is to summarise that object into a single label. That label is often suitable as a default name.
as_label(var)

R

# creates a symbol from a string
sym("height")

Resources

tidyeval book - https://tidyeval.tidyverse.org/ or tidyeval post - https://rpubs.com/lionel-/tidyeval-introduction
tidyeval webinar - https://www.rstudio.com/resources/webinars/tidy-eval/
"Tidy evaluation in 5 minutes" by Hadley Wickham - https://www.youtube.com/watch?v=nERXS3ssntw
Metaprogramming chapters in "Advanced R" - https://adv-r.hadley.nz/meta.html
tidyeval cheatsheet - https://www.rstudio.com/resources/cheatsheets/
https://github.com/tidyverse/dplyr/blob/master/vignettes/programming.Rmd
https://github.com/romatik/touring_the_tidyverse
https://tidyeval.tidyverse.org/dplyr.html

R

# remove the objects
rm(a, b, d, df, filter_which, group_var, grouped_mean, grouped_mean2, grouped_mean3, grouped_mean4, jetlag, my_summarise, summary_var, var, vars)

R

pacman::p_unload(pacman::p_loaded(), character.only = TRUE)