Анализ формулы с помощью rlang

Я пытаюсь научиться писать на R предметно-ориентированный язык с rlang. Это всего лишь мини-пример, чтобы понять, как работают синтаксический анализ и операции.

Скажем, у меня есть следующие данные:

> 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

person Alex    schedule 15.02.2018    source источник


Ответы (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)
person G. Grothendieck    schedule 15.02.2018
comment
Спасибо за комментарий. Я был постоянным пользователем R в течение нескольких лет, но, похоже, есть еще одна сторона R, которую я никогда не использовал. eval - одна из многих команд, которых я не касался. Какова цель eval? Почему бы просто не выполнить команду, как обычно? - person Alex; 16.02.2018
comment
Тот факт, что формула может представлять код R, - это просто соглашение. R этого не знает. Мы должны оценить формулу, чтобы ее запустить. Если вы хотите сделать дополнительные предположения, например, формула может иметь только форму variable | variable ~ variable или variable | variable ~ 1 (поэтому, например, последний пример в ответе не будет разрешен), то мы могли бы избежать eval. eval обычно не одобряют, но если вы хотите иметь возможность запускать произвольный код, альтернативы нет. - person G. Grothendieck; 16.02.2018
comment
Мы добавили упрощение, в котором не используется eval, которое можно использовать, если мы хотим указать, что разрешены только указанные формулы. - person G. Grothendieck; 16.02.2018