Let's say that you have 3 time-series vectors with different sizes:
xdate = seq(as.Date("2010/1/1"), by = "day", length.out = 2789)
ydate = seq(as.Date("2010/1/1"), by = "day", length.out = 1289)
zdate = seq(as.Date("2010/1/1"), by = "day", length.out = 2245)
xf = as.factor(rep("x",2789))
yf = as.factor(rep("y",1289))
zf = as.factor(rep("z",2245))
x = rnorm(2789)
y = rnorm(1289)
z = rnorm(2245)
date = c(xdate,ydate,zdate)
value = c(x,y,z)
fact = c(xf,yf,zf)
library(tidyverse)
library(quantmod)
dat = tibble(date = as.Date(date),fact,value);head(dat)
With result:
# A tibble: 6 x 3
date fact value
<date> <fct> <dbl>
1 2010-01-01 x 1.15
2 2010-01-02 x -0.830
3 2010-01-03 x -1.93
4 2010-01-04 x -0.957
5 2010-01-05 x -0.174
6 2010-01-06 x 0.288
Now each time series as you can see has different lengths. I want to roll calculate with rollapply function in R with different rolling windows. The rolling window must be the size of each vector minus 252.
YEAR = 252
dat%>%
group_by(fact)%>%
summarise(ROLL=n()-YEAR)
# A tibble: 3 x 2
fact ROLL
<fct> <dbl>
1 x 2537
2 y 1037
3 z 1993
What I am asking and I want someone's help is that the rolling window for x is 2537 for y 1037 and for z 1993.
Is that possible to be combined somehow in a dplyr pipeline containing the rollapply function?
Separetely if i take each roll window on each vector is easy but imagine if i have 200 vectors that will be difficult.
Any help ?
CodePudding user response:
1) Convert to a wide form zoo object z and then to a list of zoo objects L, one per column of z, apply rollfun to each component of L creating a list of zoo objects and then merge back into a wide form zoo object zroll and either use that or optionally convert to long form data frame droll.
library(zoo)
z <- read.zoo(dat, split = "fact")
L <- as.list(z)
rollfun <- function(x) rollapplyr(x, length(na.omit(x)) - 252, mean)
zroll <- do.call("merge", Map(rollfun, L))
droll <- fortify.zoo(zroll, melt = TRUE)
2) This could also be expressed as a pipeline where rollfun is from above.
droll2 <- dat |>
read.zoo(split = "fact") |>
as.list() |>
Map(f = rollfun) |>
do.call(what = "merge") |>
fortify.zoo(melt = TRUE)
3) With dplyr
library(dplyr, exclude = c("lag", "filter"))
library(zoo)
dat %>%
group_by(fact) %>%
mutate(roll = rollapplyr(value, n() - 252, mean, fill = NA)) %>%
ungroup