2

我试图在 dplyr 中使用尽可能少的代码来制造多个滞后，同时坚持 tidy 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 整洁。因此，我想知道是否可以通过 tidy eval 来做到这一点？任何帮助表示赞赏，我是评估类型的新手。

4

2 回答 2

1

来自这篇博文：Romain François的多次滞后与整洁的评估

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

由reprex 包（v0.2.1.9000）于 2019 年 2 月 15 日创建

于 2019-02-16T07:37:25.217 回答
1

受@Tung 回答的启发，我尝试制作更通用的函数，看起来更像 tidyr 函数而不是 dplyr 函数，即外部变异。

# 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)
于 2019-02-16T11:54:41.737 回答