如何在 r 中加速具有多个条件的滚动回归？

Question

我有一个相当大的数据集（大约 1200 万行），我需要对包含过去 30 行条目的每一行运行滚动回归。这是一个简单的线性回归，但回归需要考虑两个因素：股票和需要运行的时间窗口。我已经找到了一种方法来运行我的 1200 万次回归，但不幸的是，这种方法需要的时间太长了。 lm() 做的工作太多，因为我只需要回归的截距和系数，但使用更简单的线性回归，例如 lmfit/lm.fit/lmList 等，到目前为止我还无法包含我的两个条件。 我也尝试过并行化回归，但由于我是初学者，我没有成功。 你能帮我尽可能加快这个计算吗？

代码：

regression <- df %>%
              rowwise() %>% 
              droplevels()%>%
              mutate(mod = list(lm(returns ~ Factor1 + Factor2 + Factor3 + Factor4,
                                   data = filter(df,
                                                 Stock == .env$Stock,
                                                 date <= .env$date,
                                                 date >= .env$datemonthbefore))))

regressionestimates <- regression %>%
  mutate(res = list(broom::tidy(mod)),
         broom::glance(mod)) %>% 
  select(date,
         Stock,
         res,
         nobs) %>% 
  unnest(res) 

Answer 1

我确信有更快的方法可以做到这一点，但这很有效。 （我认为。）

library(tidyverse)

set.seed(1000)

df <- tibble(date = rep(16001:19000, 5000),
             Stock = rep(1:5000, each = 3000)) %>%
    mutate(date = as.Date(date, origin = "1969-12-31"),
           returns = rnorm(15e6),
           Factor1 = rnorm(15e6),
           Factor2 = rnorm(15e6),
           Factor3 = rnorm(15e6),
           Factor4 = rnorm(15e6)) %>%
    nest(data = -Stock)

fit_one_stock <- function(data, window_size = 30L){
    data <- data %>% arrange(date)
    data.matrix <- as.matrix(data[,,drop = FALSE])
    steps <- nrow(data)-window_size

    output <- vector("list", steps+1)

    for(i in 0:steps){
        this_data <- data.matrix[(1+i):(window_size+i),,drop = FALSE]
        output[[i+1]]  <- coef(.lm.fit(cbind(1,this_data[,c("Factor1", "Factor2", "Factor3", "Factor4")]), this_data[,"returns"])) %>%
            setNames(c("(Intercept)", "Factor1", "Factor2", "Factor3", "Factor4"))
    }

    output

    bind_rows(output) %>%
        bind_cols(date = data[window_size:nrow(data),1])
}

tictoc::tic()
df2 <- df %>% #head(100) %>%
    mutate(models = map(data, fit_one_stock))
tictoc::toc()

df2 %>% select(-data) %>% unnest(models)