group_by и применить скользящую регрессию на основе окна, используя dplyr

Question

У меня есть некоторые данные, которые выглядят так:

# A tibble: 6,618 x 8
    Open  High   Low Close   Volumn Adjusted stock dates     
   <dbl> <dbl> <dbl> <dbl>    <dbl>    <dbl> <chr> <date>    
 1  232.  237.  230.  233. 15470700     233. 1     2007-01-03
 2  234.  241.  233.  241. 15834200     241. 1     2007-01-04
 3  240.  243.  238.  243. 13795600     243. 1     2007-01-05
 4  243.  244.  240.  241.  9544400     241. 1     2007-01-08

Я хотел бы рассчитать 30-дневную скользящую регрессию. Сейчас у меня есть:

df %>%
  group_by(stock) %>% 
  rollapply(
    width = 30,
    FUN = function(x){
      LinearModel = lm(formula = Close ~ date, data = as.data.frame(x))
      return(LinearModel$coef)
    })

Это не работает, но я хотел бы иметь новые столбцы в df, где у меня есть 30-дневные уклоны и перехваты. Я попытался обернуть вышеупомянутую функцию в mutate без удачи. Я пытаюсь сделать это для каждой группы в столбце stock.

Данные:

library(quantmod)
library(dplyr)
library(stats)
getSymbols(c("GOOG", "MSFT"), from = "2010-01-01", to = "2010-06-01")

names_for_column <- c("Open", "High", "Low", "Close", "Volumn", "Adjusted")
colnames(GOOG) <- names_for_column
colnames(MSFT) <- names_for_column

df <- bind_rows(data.frame(GOOG), data.frame(MSFT), .id = "stock") %>% 
  mutate(dates = c(time(GOOG), time(MSFT))) %>% 
  tibble()

Ожидаемый результат:

    Open  High   Low Close   Volumn Adjusted stock dates          intercept   slope
   <dbl> <dbl> <dbl> <dbl>    <dbl>    <dbl> <chr> <date>          
 1  232.  237.  230.  233. 15470700     233. 1     2007-01-03        NA (for 30 obs)
...
 30  234.  241.  233.  241. 15834200     241. 1     2007-01-04      -0.324     0.284

РЕДАКТИРОВАТЬ:

Мне бы хотелось, чтобы вывод был похож на скользящую версию:

df %>%
  filter(stock == 1) %>%
  condense(LinearModel = lm(Close ~ dates, data = .)) %>%
  tidy(LinearModel) %>%
  pivot_wider(names_from = term, values_from = estimate:p.value)

, которая дает:

# A tibble: 1 x 8
  `estimate_(Inte… estimate_dates `std.error_(Int… std.error_dates `statistic_(Int…
             <dbl>          <dbl>            <dbl>           <dbl>            <dbl>
1           -3123.          0.231             25.5         0.00159            -123.
# … with 3 more variables: statistic_dates <dbl>, `p.value_(Intercept)` <dbl>,
#   p.value_dates <dbl>

Так что я надеюсь связать это с исходными данными.

Когда я запускаю:

df %>%
  filter(stock == 1) %>%
  condense(out = lm(Close ~ dates, data =.) %>% 
             tidy)

Я получаю:

# A tibble: 1 x 1
# Rowwise: 
  out             
  <list>          
1 <tibble [2 × 5]>

Добавление unnest()

df %>%
  filter(stock == 1) %>%
  condense(out = lm(Close ~ dates, data =.) %>% 
             tidy) %>% 
  unnest(out)

Я получаю тот же результат ( без части pivot_wider), как раньше:

# A tibble: 2 x 5
  term         estimate std.error statistic p.value
  <chr>           <dbl>     <dbl>     <dbl>   <dbl>
1 (Intercept) -3123.     25.5         -123.       0
2 dates           0.231   0.00159      145.       0

Я хочу сгладить эти данные и связать их с соответствующими датами в исходных данных (с первыми 30 строками, содержащими NA). В основном меня интересуют значения -3123 и 0.231 из столбца estimate.

#

EDIT -

Answer 1

Мы можем сделать group_split и map над элементами list и затем применить rollapply

library(zoo)
library(dplyr)
library(purrr)
out <- df %>% 
        group_split(stock) %>%
        map(~ rollapply(.x,
           width = 30,
           FUN =  function(dat) {
           LinearModel = lm(formula = Close ~ dates,  as.data.frame(dat))
           LinearModel$coef
           }, by.column = FALSE, fill = NA_real_,  align = "right"))


length(out)
#[1] 2

---

Если мы хотим обновить исходный набор данных с большим количеством столбцов

out <-  df %>% 
       group_split(stock) %>%
       map_dfr(~ {
           subdat <- .x
           rollapply(subdat,
           width = 30,
           FUN =  function(dat) {
           LinearModel = lm(formula = Close ~ dates,  as.data.frame(dat))
           LinearModel$coef
           }, by.column = FALSE, fill = NA_real_,  align = "right") %>% 
               as.data.frame %>%
               bind_cols(subdat, .)

           }

           )

ncol(out)
#[1] 38

ncol(df)
#[1] 8

---

В devel-версии dplyr мы также можем сделать

out1 <- df %>% 
           group_by(stock) %>%
          condense(out =rollapply(cur_data(), width = 30,
           FUN = function(dat) lm(Close ~ dates, as.data.frame(dat))$coef,
           by.column = FALSE, fill = NA_real_, align = "right") %>% 
           as.data.frame %>%
           bind_cols(cur_data(), .))
out1
# A tibble: 2 x 2
# Rowwise:  stock
#  stock out                  
#  <chr> <list>               
#1 1     <tibble [3,309 × 37]>
#2 2     <tibble [3,309 × 37]>

Столбец list может быть unnest ed, когда это требуется

out1 %>% 
    unnest(c(out)) %>%
    head(3)
# A tibble: 3 x 38
#  stock  Open  High   Low Close Volumn Adjusted dates      `(Intercept)` `dates2007-01-0…
#  <chr> <dbl> <dbl> <dbl> <dbl>  <dbl>    <dbl> <date>             <dbl>            <dbl>
#1 1      232.  237.  230.  233. 1.55e7     233. 2007-01-03            NA               NA
#2 1      234.  241.  233.  241. 1.58e7     241. 2007-01-04            NA               NA
#3 1      240.  243.  238.  243. 1.38e7     243. 2007-01-05            NA               NA
# … with 28 more variables: `dates2007-01-05` <dbl>, `dates2007-01-08` <dbl>,
#   `dates2007-01-09` <dbl>, `dates2007-01-10` <dbl>, `dates2007-01-11` <dbl>,
#   `dates2007-01-12` <dbl>, `dates2007-01-16` <dbl>, `dates2007-01-17` <dbl>,
#   `dates2007-01-18` <dbl>, `dates2007-01-19` <dbl>, `dates2007-01-22` <dbl>,
#   `dates2007-01-23` <dbl>, `dates2007-01-24` <dbl>, `dates2007-01-25` <dbl>,
#   `dates2007-01-26` <dbl>, `dates2007-01-29` <dbl>, `dates2007-01-30` <dbl>,
#   `dates2007-01-31` <dbl>, `dates2007-02-01` <dbl>, `dates2007-02-02` <dbl>,
#   `dates2007-02-05` <dbl>, `dates2007-02-06` <dbl>, `dates2007-02-07` <dbl>,
#   `dates2007-02-08` <dbl>, `dates2007-02-09` <dbl>, `dates2007-02-12` <dbl>,
#   `dates2007-02-13` <dbl>, `dates2007-02-14` <dbl>

---

Мы можем применить tidy в пределах condense

library(broom)

out3 <-  df %>% 
   group_split(stock) %>%
   map_dfr(~ {
       subdat <- .x
       rollapply(subdat,
       width = 30,
       FUN =  function(dat) {
       LinearModel = lm(formula = Close ~ dates,  as.data.frame(dat))
       tidy(LinearModel)
       }, by.column = FALSE, fill = NA_real_,  align = "right") %>% 
           as.data.frame %>%
           bind_cols(subdat, .)

       }

       )



dim(out3)
#[1] 6618   13
names(out3)
# [1] "Open"      "High"      "Low"       "Close"     "Volumn"    "Adjusted"  "stock"    
# [8] "dates"     "term"      "estimate"  "std.error" "statistic" "p.value"