使用 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，如果是，它 returns 是 eval_lhs 的平均值；否则，它将 eval_lhs 次评估的右侧附加到 data 和 returns 那。

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)

使用 rlang 解析公式

Parsing a formula with rlang

r

rlang

更新