How to efficiently nest() and unnest_wider() in R's tidyverse - r

Question

I am estimating rolling regressions on grouped data.
First, I group_by() and nest() my data by group.
Second, I use map() to estimate rolling regressions with a custom function my_beta(), which returns a list column.
The last step is where I stumble.
I want to extract the groups, dates, and coefficients so that I can merge the coefficients back to my original tibble.
However, my current solution requires three unnest() operations and a bind_cols().
The multiple unnest()s seem inefficient and the bind_cols() seems error prone.
Is there a syntactically and computationally more efficient way to estimate these rolling regressions? My actual data will have 10,000ish groups and 200,000ish observations.
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
Created on 2020-02-25 by the reprex package (v0.3.0)

Answer 1

We could simplify the code a bit with
res %>%
unnest(cols = c(data, coefs)) %>%
unnest_wider(col = coefs, names_sep = '_') %>%
select(-coefs_...1)
Where res is
res <-
df %>%
as_tsibble(key = group, index = date) %>%
group_by_key() %>%
nest() %>%
mutate(coefs = purrr::map(data, ~ pslide(., my_beta, .size = 5)))
The code that does the estimate part is left untouched. This only addresses the data wrangling part, about multiple unnest()s and bind_cols().
I haven't done a performance benchmark.