Как я могу использовать rollapply с окном 5 месяцев?

Question

Я заметил это в документации 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)
               ))

Можно ли каким-то образом использовать rollapply() с 5-месячным скользящим окном для расчета скользящего среднего val? Проблема с 5-месячным скользящим окном заключается в том, что количество дней в месяце меняется ...

ПРИМЕЧАНИЕ: я бы предпочел решение base-R, но другие библиотеки было бы интересно посмотреть

Answer 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)

С другой стороны, мы могли бы написать w вот так с lubridate.

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 могут незначительно отличаться в зависимости от немного разных предположений.

Answer 2

Улучшение идей Дж. Гротендика, с которыми я пошел:

  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)

Похоже, что работает правильно ...