如何在 R 的 tidyverse 中有效地 nest() 和 unnest_wider()

Question

我正在估计分组数据的滚动回归。 首先，我按组group_by()和nest()我的数据。 其次，我使用map()来估计带有自定义函数my_beta()滚动回归，该函数返回一个列表列。

最后一步是我绊倒的地方。 我想提取组、日期和系数，以便我可以将系数合并回我原来的小标题。 但是，我当前的解决方案需要三个unnest()操作和一个bind_cols() 。 多个unnest()似乎效率低下，而bind_cols()似乎容易出错。

是否有一种在语法和计算上更有效的方法来估计这些滚动回归？ 我的实际数据将有 10,000 个组和 200,000 个观察。

library(tidyverse)
library(tsibble)
#> 
#> Attaching package: 'tsibble'
#> The following object is masked from 'package:dplyr':
#> 
#>     id

set.seed(2001)
df <-
    tibble(
        date = 1:20,
        y = runif(20),
        x = runif(20),
        z = runif(20),
        group = rep(1:2, each = 10)
    )


my_beta <- function(...) {
    tail(coef(lm(y ~ x + z, data = list(...))), n = -1)
}

current_output <- df %>%
    as_tsibble(key = group, index = date) %>%
    group_by_key() %>%
    nest() %>%
    mutate(coefs = purrr::map(data, ~ pslide(., my_beta, .size = 5))) %>%
    unnest(coefs) %>%
    unnest_wider(coefs, names_sep = '_') %>% 
    ungroup()
#> New names:
#> * `` -> ...1
#> New names:
#> * `` -> ...1
#> New names:
#> * `` -> ...1
#> New names:
#> * `` -> ...1
#> New names:
#> * `` -> ...1
#> New names:
#> * `` -> ...1
#> New names:
#> * `` -> ...1
#> New names:
#> * `` -> ...1
current_output
#> # A tibble: 20 x 5
#>    group data               coefs_...1 coefs_x coefs_z
#>    <int> <list>             <lgl>        <dbl>   <dbl>
#>  1     1 <tsibble [10 × 4]> NA         NA      NA     
#>  2     1 <tsibble [10 × 4]> NA         NA      NA     
#>  3     1 <tsibble [10 × 4]> NA         NA      NA     
#>  4     1 <tsibble [10 × 4]> NA         NA      NA     
#>  5     1 <tsibble [10 × 4]> NA          1.46    2.08  
#>  6     1 <tsibble [10 × 4]> NA          0.141  -0.396 
#>  7     1 <tsibble [10 × 4]> NA          0.754   1.10  
#>  8     1 <tsibble [10 × 4]> NA          0.651   0.889 
#>  9     1 <tsibble [10 × 4]> NA          0.743   0.954 
#> 10     1 <tsibble [10 × 4]> NA          0.308   0.795 
#> 11     2 <tsibble [10 × 4]> NA         NA      NA     
#> 12     2 <tsibble [10 × 4]> NA         NA      NA     
#> 13     2 <tsibble [10 × 4]> NA         NA      NA     
#> 14     2 <tsibble [10 × 4]> NA         NA      NA     
#> 15     2 <tsibble [10 × 4]> NA         -0.0433 -0.252 
#> 16     2 <tsibble [10 × 4]> NA          0.696   0.334 
#> 17     2 <tsibble [10 × 4]> NA          0.594  -0.0698
#> 18     2 <tsibble [10 × 4]> NA          0.881   0.0474
#> 19     2 <tsibble [10 × 4]> NA          3.23   -1.32  
#> 20     2 <tsibble [10 × 4]> NA         -0.942   1.85


desired_output <- df %>%
    bind_cols(current_output %>% select(coefs_x, coefs_z))
desired_output
#> # A tibble: 20 x 7
#>     date     y     x      z group coefs_x coefs_z
#>    <int> <dbl> <dbl>  <dbl> <int>   <dbl>   <dbl>
#>  1     1 0.759 0.368 0.644      1 NA      NA     
#>  2     2 0.608 0.992 0.0542     1 NA      NA     
#>  3     3 0.218 0.815 0.252      1 NA      NA     
#>  4     4 0.229 0.982 0.0606     1 NA      NA     
#>  5     5 0.153 0.275 0.488      1  1.46    2.08  
#>  6     6 0.374 0.856 0.268      1  0.141  -0.396 
#>  7     7 0.619 0.737 0.599      1  0.754   1.10  
#>  8     8 0.259 0.641 0.189      1  0.651   0.889 
#>  9     9 0.637 0.598 0.543      1  0.743   0.954 
#> 10    10 0.325 0.990 0.0265     1  0.308   0.795 
#> 11    11 0.816 0.519 0.351      2 NA      NA     
#> 12    12 0.717 0.766 0.333      2 NA      NA     
#> 13    13 0.781 0.365 0.380      2 NA      NA     
#> 14    14 0.838 0.924 0.0778     2 NA      NA     
#> 15    15 0.736 0.453 0.258      2 -0.0433 -0.252 
#> 16    16 0.173 0.291 0.328      2  0.696   0.334 
#> 17    17 0.677 0.714 0.884      2  0.594  -0.0698
#> 18    18 0.833 0.718 0.902      2  0.881   0.0474
#> 19    19 0.134 0.351 0.422      2  3.23   -1.32  
#> 20    20 0.675 0.963 0.981      2 -0.942   1.85

^{由reprex 包(v0.3.0) 于 2020 年 2 月 25 日创建}

Answer 1

我们可以稍微简化一下代码

res %>% 
  unnest(cols = c(data, coefs)) %>% 
  unnest_wider(col = coefs, names_sep = '_') %>% 
  select(-coefs_...1)

---

res在哪里

res <- 
  df %>%
  as_tsibble(key = group, index = date) %>%
  group_by_key() %>%
  nest() %>%
  mutate(coefs = purrr::map(data, ~ pslide(., my_beta, .size = 5))) 

---

执行估计部分的代码保持不变。 这仅解决了数据bind_cols()部分，关于多个unnest() s 和bind_cols() 。

我还没有做过性能基准测试。