如何在 R 中使用滑块使用多重滚动 windows?

How to use multiple rolling windows using slider in R?

这是我的玩具数据。

df <- tibble::tribble(
         ~fund,       ~dates,    ~y,    ~x,
      "Fund_A", "03/31/2021",  0.04,  0.04,
      "Fund_A", "04/30/2021",  0.04, -0.03,
      "Fund_A", "05/31/2021",  0.03,  0.04,
      "Fund_A", "06/30/2021", -0.01,  0.03,
      "Fund_A", "07/31/2021", -0.06, -0.03,
      "Fund_A", "08/31/2021",  0.04,  0.05,
      "Fund_A", "09/30/2021",  0.01, -0.04,
      "Fund_A", "10/31/2021",  0.02, -0.01,
      "Fund_A", "11/30/2021",  0.03, -0.03,
      "Fund_A", "12/31/2021", -0.02,  0.06,
      "Fund_B", "03/31/2021",  0.01,  0.02,
      "Fund_B", "04/30/2021",  0.01,  0.05,
      "Fund_B", "05/31/2021",  0.05, -0.05,
      "Fund_B", "06/30/2021",  0.01, -0.02,
      "Fund_B", "07/31/2021",  0.04,  0.09,
      "Fund_B", "08/31/2021",  0.02, -0.01,
      "Fund_B", "09/30/2021",  0.02,  0.02,
      "Fund_B", "10/31/2021", -0.01,  0.01,
      "Fund_B", "11/30/2021",  0.05,  0.01,
      "Fund_B", "12/31/2021", -0.03,  0.02
      )

我有代码 运行 滚动回归并使用滑块包吐出回归输出。

library(tidyverse)
library(slider)
library(broom)

df %>% 
  group_by(fund) %>%
  mutate(model = slide(.x = cur_data(), 
                         .f = possibly(~(lm(y ~ x, data = .x) %>% 
                                           tidy() %>% 
                                           filter(term != "(Intercept)")),
                                       otherwise = NA),
                         .before = 5)) %>%
  ungroup() %>%
  unnest(model)

现在,我希望能够 运行 上面的代码具有多个资金值和“.before”值,并将结果合并到一个数据框中。换句话说,我希望上面的代码在 say .before = seq(4, 7,1) 上运行。看到使用 purrr 地图的尝试会很有趣!

要多次执行相同的操作,我们可以使用 for-loopapply 函数。

为了保持代码整洁,我先从代码中做了一个函数来重复,以.before的值作为参数。然后 lapply() 多次执行该函数。然后 do.call(rbind) 将生成的数据帧绑定在一起。

df <- tibble::tribble(
    ~fund,       ~dates,    ~y,    ~x,
    "Fund_A", "03/31/2021",  0.04,  0.04,
    ...
    "Fund_B", "12/31/2021", -0.03,  0.02
)

library('tidyverse')
library('slider')
library('broom')

#
# function that performs the action for a single value for .before; returns a dataframe
# example: calculate_coefficient(df, 4)
#
calculate_lm_values <- function(df, .before) {
    
    df %>% 
        group_by(fund) %>%
        mutate(model = slide(.x = cur_data(), 
                             .f = possibly(~(lm(y ~ x, data = .x) %>%
                                                 tidy() %>% 
                                                 filter(term != "(Intercept)")),
                                           otherwise = NA),
                             .before = .before),
               before = .before) %>%
        ungroup() %>%
        unnest(model)
    
}

#
# run function multiple times and bind rows together 
#
df_results2 <- map_dfr(4:7, ~calculate_lm_values(df, .x))

# alternatively:
#   df_results <- lapply( 4:7, function(x) calculate_lm_values(df, x) )
#   df_results <- do.call(rbind, df_results)

df_results