How to use multiple rolling windows using slider in R?

Viewed 65

Here is my toy data.

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
      )

I have code that runs the rolling regression and spits out the regression output using slider package.

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)

Now, I want to be able to run the above code with multiple values of funds and ".before" values and combine the results in one dataframe. In other words, I want the above code to work on say .before = seq(4, 7,1). It would be interesting to see an attempt using purrr map!

1 Answers

To carry out the same operation multiple times, we can use a for-loop or an apply function.

To keep the code tidy, I first made a function out of the code to repeat, with the value of .before as a parameter. Then lapply() executes that function multiple times. Then do.call(rbind) binds the resulting dataframes together.

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
Related