如何在 5 个月的窗口中使用 rollapply？答案

【问题标题】：How can I use rollapply with a 5 month window?如何在 5 个月的窗口中使用 rollapply？
【发布时间】：2019-04-04 21:11:36
【问题描述】：

我在rollapply() 的文档中注意到这一点要提前 3 天：

## rolling mean by time window (e.g., 3 days) rather than
## by number of observations (e.g., when these are unequally spaced):
#
## - test data
tt <- as.Date("2000-01-01") + c(1, 2, 5, 6, 7, 8, 10)
z <- zoo(seq_along(tt), tt)
## - fill it out to a daily series, zm, using NAs
## using a zero width zoo series g on a grid
g <- zoo(, seq(start(z), end(z), "day"))
zm <- merge(z, g)
## - 3-day rolling mean
rollapply(zm, 3, mean, na.rm = TRUE, fill = NA)

假设我有以下数据：

data.zoo <- read.zoo(
                data.frame(
                    date = sample(seq(as.Date('2001-04-12'), as.Date("2019-04-05"), by="day"), 600), 
                    val = runif(1:600), 
                    val2 = runif(1:600)
               ))

是否可以以某种方式使用具有 5 个月滚动窗口的 rollapply() 来计算 val 的滚动平均值？ 5个月滚动窗口的问题是一个月的天数会变化......

注意：我更喜欢 base-R 解决方案，但其他库会很有趣

【问题讨论】：

标签： r zoo

【解决方案1】：

由于宽度可以是宽度向量，输入的每一行对应一个宽度，我们可以简单地计算每个日期与前 5 个月之间的天数，并将这些数字用作宽度向量：

library(zoo)

ym <- as.yearmon(time(data.zoo))
w <- as.Date(ym) - as.Date(ym - 5/12)
r <- rollapplyr(data.zoo, w, mean, fill = NA)

或者，我们可以使用 lubridate 像这样写 w。

library(lubridate)
w <- time(data.zoo) - (time(data.zoo) %m-% months(5))

更新

如果可能缺少日期，那么

library(lubridate)
w <- sapply(time(data.zoo), function(x)
  length(intersect(seq(x %m-% months(5), x, "day"), time(data.zoo)))

或重复此操作，将%m-% months(5) 替换为不使用额外包的subtract5m：

subtract5m <- function(x) {
  if (length(x) == 1) seq(x, length = 2, by = "-5 month")[2]
  else as.Date(sapply(x, subtract5m))
}
w <- sapply(time(data.zoo), function(x)
  length(intersect(seq(subtract5m(x), x, "day"), time(data.zoo))))

请注意，由于 5 个月前的定义不明确，w 的各种计算可能会因假设略有不同而略有不同。

【讨论】：

我在想，这不能用yearmon重写吗？
好主意。已添加。
您假设这些天是连续的，这在我的示例中是失败的。如果它们不是连续的（通常我们处理业务日期）怎么办？作为对此的改进，如果缺少几个月怎么办？（我已经修改了我的示例以显示这一点）
谢谢。有没有办法让 yearmon 方法来处理缺失的日期？
查看更新。第二个计算不使用 yearmon 但确实避免使用额外的包。

【解决方案2】：

改进 G. Grothendieck 的想法：

  ym <- as.yearmon(time(data.zoo))
  ym.cutoff.ideal <- ym - 5/12
  ym.cutoff.closest.to.ideal <- as.yearmon(time(data.zoo)[findInterval(as.Date(ym.cutoff.ideal), as.Date(ym)) + 1])
  w <- time(data.zoo) - as.Date(ym.cutoff.closest.to.ideal) + 1
  r <- rollapplyr(data.zoo, w, mean, fill = NA)

它看起来工作正常......

【讨论】：