使用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)