如何在 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-loop 或 apply 函数。
为了保持代码整洁,我先从代码中做了一个函数来重复,以.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
这是我的玩具数据。
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-loop 或 apply 函数。
为了保持代码整洁,我先从代码中做了一个函数来重复,以.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