Dplyr несколько лаги Tidy Eval?

Я пытаюсь сделать несколько лагов, используя наименьшее количество кода в dplyr, придерживаясь при этом аккуратного eval. Работает следующий код стандартной оценки (SE):

#if(!require(dplyr)) install.packages("dplyr");
library(dplyr)

a=as_tibble(c(1:100))

lags=3

lag_prefix=paste0("L", 1:lags, ".y") 

multi_lag=setNames(paste("lag(.,", 1:lags, ")"), lag_prefix)

a %>% mutate_at(vars(value), funs_(multi_lag)) #final line

# A tibble: 100 x 4
value  L1.y  L2.y  L3.y
<int> <int> <int> <int>
1     1    NA    NA    NA
2     2     1    NA    NA
3     3     2     1    NA
4     4     3     2     1
5     5     4     3     2
6     6     5     4     3
7     7     6     5     4
8     8     7     6     5
9     9     8     7     6
10    10     9     8     7
# ... with 90 more rows

Тем не менее, вы заметите, что в последней строке не используется Tidy Eval, но прибегает к SE. Информация о пакете, относящаяся к команде funs_, говорит, что она излишняя из-за аккуратного eval. Таким образом, мне интересно, если это можно сделать с помощью приборки Eval? Любая помощь приветствуется, я новичок в оценке типов.

Источник

2 ответа

Решение

Из этого поста в блоге: множественные лаги с аккуратной оценкой Ромена Франсуа

library(rlang)
library(tidyverse)

a <- as_tibble(c(1:100))
n_lags <- 3

lags <- function(var, n = 3) {
  var <- enquo(var)
  indices <- seq_len(n)

  # create a list of quosures by looping over `indices`
  # then give them names for `mutate` to use later
  map(indices, ~ quo(lag(!!var, !!.x))) %>%
    set_names(sprintf("L_%02d.%s", indices, "y"))
}

# unquote the list of quosures so that they are evaluated by `mutate`
a %>% 
  mutate_at(vars(value), funs(!!!lags(value, n_lags)))

#> # A tibble: 100 x 4
#>    value L_01.y L_02.y L_03.y
#>    <int>  <int>  <int>  <int>
#>  1     1     NA     NA     NA
#>  2     2      1     NA     NA
#>  3     3      2      1     NA
#>  4     4      3      2      1
#>  5     5      4      3      2
#>  6     6      5      4      3
#>  7     7      6      5      4
#>  8     8      7      6      5
#>  9     9      8      7      6
#> 10    10      9      8      7
#> # ... with 90 more rows

Создано 2019-02-15 пакетом представлением (v0.2.1.9000)

Источник

Вдохновленный ответом @Tung, я попытался сделать более общую функцию, которая больше похожа на функции tidyr, а не на функции dplyr, т. Е. Вне mutate.

# lags function
lags <- function(data, var, nlags) {
  var <- enquos(var)

  data %>% 
    bind_cols(
      map_dfc(seq_len(n), 
              function(x) {
                new_var <- sprintf("L_%02d.%s", x, "y")
                data %>% transmute(new_var := lag(!!!var, x))
                }
                ))
}

# Apply function to data frame
a <- as_tibble(c(1:100))

a %>% 
  lags(value, 3)
Источник
Другие вопросы по тегам