Rollapply with different rolling window on each vector of time series

Question

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 ?

Answer 1

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