Как эффективно nest () и unnest_wider () в Tidyverse R - PullRequest
Новая
       87

Как эффективно nest () и unnest_wider () в Tidyverse R

1 голос
/ 25 февраля 2020

Я оцениваю скользящие регрессии на сгруппированных данных. Сначала я group_by() и nest() мои данные по группам. Во-вторых, я использую map() для оценки скользящих регрессий с помощью пользовательской функции my_beta(), которая возвращает столбец списка.

Последний шаг - это то, где я спотыкаюсь. Я хочу извлечь группы, даты и коэффициенты, чтобы я мог объединить коэффициенты обратно в исходную таблицу. Однако мое текущее решение требует три unnest() операций и bind_cols(). Множественные unnest() кажутся неэффективными, а bind_cols() кажется подверженным ошибкам.

Существует ли синтаксически и вычислительно более эффективный способ оценки этих регрессий качения? Мои фактические данные будут иметь 10 000i sh групп и 200 000i sh наблюдений. 

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

Создано в 2020-02-25 с помощью пакета Представить (v0 .3.0)

1 Ответ

0 голосов
/ 25 февраля 2020

Мы могли бы немного упростить код с помощью 

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)))

Код, выполняющий часть оценки, остался нетронутым , Это касается только части обработки данных, о нескольких unnest() s и bind_cols().

Я не выполнил тест производительности.

...