使用 rlang 解析公式

Question

我正在尝试学习如何使用rlang 在 R 中编写特定领域的语言。这只是一个了解解析和操作如何工作的小例子。

假设我有以下数据：

> top <- seq(2,10,2)
> bottom <- rep(2,length(top))
> times <- rep(10,length(top))
> df <- tibble::tibble(top,bottom,times)
> df
    top bottom times
  <dbl>  <dbl> <dbl>
1  2.00   2.00  10.0
2  4.00   2.00  10.0
3  6.00   2.00  10.0
4  8.00   2.00  10.0
5  10.0   2.00  10.0

我想要一种采用以下示例的领域特定语言

1.

df_result1 <- divi(top | bottom ~ times, df)

2.

df_result2 <- divi(top | bottom ~ 1, df)

并产生以下内容：

1.

> df_result1
# A tibble: 5 x 4
    top bottom times result
  <dbl>  <dbl> <dbl>  <dbl>
1  2.00   2.00  10.0   10.0
2  4.00   2.00  10.0   20.0
3  6.00   2.00  10.0   30.0
4  8.00   2.00  10.0   40.0
5  10.0   2.00  10.0   50.0

2.

> df_result2
# A tibble: 1 x 1
  result
   <dbl>
1   3.00

在dplyr 行话中，函数是：

1.

df_result1 <- df %>% mutate(result = (top/bottom)*times)

2.

df_result2 <- df %>% summarise(result = mean((top/bottom)))

更新

经过一些特别的工作，我为其中一个案例提出了以下建议。它在技术上可能很丑陋，但它可以完成工作。

divi <- function(form, data){
  data %>% mutate(result=eval_tidy(f_lhs(f_lhs(form)))/
                      eval_tidy(f_rhs(f_lhs(form)))*
  eval_tidy(f_rhs(form)))
}

divi(top | bottom ~ times, df)

    top bottom times ressult
  <dbl>  <dbl> <dbl>   <dbl>
1     2      2    10      10
2     4      2    10      20
3     6      2    10      30
4     8      2    10      40
5    10      2    10      50

Answer 1

我们假设这里的一般情况是我们想要替换 |用 / 计算左侧，如果右侧为 1，则取其平均值，如果不是，则乘以右侧，然后将其全部附加到数据中。

这不使用 rlang 但看起来很短。它将公式分解为左侧、右侧和环境（lhs、rhs、e）并在替换 | 时评估左侧与/给予eval_lhs。然后它检查右手边是否为 1，如果是，则返回 eval_lhs 的平均值；否则，它将 eval_lhs 乘以求值的右侧附加到 data 并返回。

library(tibble)

divi <- function(formula, data) {
   lhs <- formula[[2]]
   rhs <- formula[[3]]
   e <- environment(formula)
   eval_lhs <- eval(do.call("substitute", list(lhs, list("|" = `/`))), data, e)
   if (identical(rhs, 1)) tibble(result = mean(eval_lhs))
   else as.tibble(cbind(data, result = eval_lhs * eval(rhs, data, e)))
}

现在进行一些测试：

divi(top | bottom ~ times, df)
## # A tibble: 5 x 4
##     top bottom times result
##   <dbl>  <dbl> <dbl>  <dbl>
## 1  2.00   2.00  10.0   10.0
## 2  4.00   2.00  10.0   20.0
## 3  6.00   2.00  10.0   30.0
## 4  8.00   2.00  10.0   40.0
## 5 10.0    2.00  10.0   50.0

divi(top | bottom ~ 1, df)
## # A tibble: 1 x 1
##   result
##    <dbl>
## 1   3.00

divi((top - bottom) | (top + bottom) ~ times^2, df)
## # A tibble: 5 x 4
##     top bottom times result
##   <dbl>  <dbl> <dbl>  <dbl>
## 1  2.00   2.00  10.0    0  
## 2  4.00   2.00  10.0   33.3
## 3  6.00   2.00  10.0   50.0
## 4  8.00   2.00  10.0   60.0
## 5 10.0    2.00  10.0   66.7

如果我们愿意限制输入以便允许的唯一输入形式是：

variable | variable ~ variable
variable | variable ~ 1

并且所有变量都是数据中的列，并且没有变量在公式中出现多次，那么我们可以这样简化：

divi0 <- function(formula, data) {
  d <- get_all_vars(formula, data)
  if (ncol(d) == 2) tibble(result = mean(d[[1]] / d[[2]]))
  else as.tibble(cbind(data, result = d[[1]] / d[[2]] * d[[3]]))
}

divi0(top | bottom ~ times, df)
divi0(top | bottom | top ~ 1, df)

这种简化只使用了公式中变量的数量和顺序，而忽略了运算符，例如，它们都给出了相同的答案，因为它们都以相同的顺序列出了相同的变量：

divi0(top | bottom ~ times, df)
divi0(~ top + bottom | times, df)
divi0(~ top * bottom * times, df)