Несколько лагов с dplyr

Question

Я имею в виду отличный пост на

https://purrple.cat/blog/2018/03/02/multiple-lags-with-tidy-evaluation/

Что я хочу сделать, так это создать функцию, способную, как dplyr, генерировать новые столбцы, которые являются запаздывающей версией существующих столбцов в фрейм данных. Например, вы можете сделать это вручную как

 library(dplyr)
 library(rlang)

 d2 <- tibble(x1 =1:10, x2=10:19,  x3=50:59)

 d3 <- d2%>%mutate(x1lag1=lag(x1, 1), x1lag2=lag(x1,2))

но это становится быстро утомительным, когда вам нужно сделать несколько лагов разные колонки. Одним из решений по ссылке выше является следующее

lags <- function(var, n=10){
 var <- enquo(var)

  indices <- seq_len(n)
  map( indices, ~quo(lag(!!var, !!.x)) ) %>%
   set_names(sprintf("lag_%s_%02d", quo_text(var), indices))

 }


d4 <- d2 %>%
  mutate( !!!lags(x1, 3), !!!lags(x2,3) )

Кто-нибудь знает, как это можно сделать более общим? Я имею в виду, что я хотел бы взять фиксированное количество лагов в списке столбцов (х1 и х2, например), просто передавая список столбцов и без повторение команд для x1 и x2.

Любое предложение приветствуется.

Answer 1

Я думаю, что идея состоит в том, чтобы использовать ... вместо var, что будет соответствовать духу вашей функции.

Для этого потребовалось изменить enquo() на enquos(), и я использую здесь crossing и map2, но, вероятно, есть более элегантный способ сделать это ...

library(tidyverse)
library(rlang)
#> 
#> Attaching package: 'rlang'
#> The following objects are masked from 'package:purrr':
#> 
#>     %@%, as_function, flatten, flatten_chr, flatten_dbl,
#>     flatten_int, flatten_lgl, flatten_raw, invoke, list_along,
#>     modify, prepend, splice

d <- data_frame(x = seq_len(100),
                y = rnorm(100))
#> Warning: `data_frame()` is deprecated, use `tibble()`.
#> This warning is displayed once per session.

multijetlag <- function(data, ..., n=10){
  variable <- enquos(...)

  indices <- seq_len(n)
  combos <- crossing(indices, var =as.list(variable))

  quosures <- map2(combos$indices, combos$var,
                   ~quo(lag(!!.y, !!.x)) ) %>% 
    set_names(paste("lag", combos$indices, map_chr(combos$var, quo_text), sep = "_"))
  mutate( data, !!!quosures )

}

multijetlag(d, x, y, n=3)
#> # A tibble: 100 x 8
#>        x       y lag_1_x  lag_1_y lag_2_x  lag_2_y lag_3_x lag_3_y
#>    <int>   <dbl>   <int>    <dbl>   <int>    <dbl>   <int>   <dbl>
#>  1     1  0.213       NA  NA           NA  NA           NA  NA    
#>  2     2  0.277        1   0.213       NA  NA           NA  NA    
#>  3     3 -0.517        2   0.277        1   0.213       NA  NA    
#>  4     4 -0.671        3  -0.517        2   0.277        1   0.213
#>  5     5 -1.12         4  -0.671        3  -0.517        2   0.277
#>  6     6 -0.296        5  -1.12         4  -0.671        3  -0.517
#>  7     7 -1.18         6  -0.296        5  -1.12         4  -0.671
#>  8     8  0.0582       7  -1.18         6  -0.296        5  -1.12 
#>  9     9 -0.455        8   0.0582       7  -1.18         6  -0.296
#> 10    10 -0.969        9  -0.455        8   0.0582       7  -1.18 
#> # … with 90 more rows

^{Создано в 2019-04-23 пакетом Представить (v0.2.1)}