根据函数计算具有不规则间距的时间序列的加权和

Question

给定一个数据帧，其中包含具有不规则间隔的时间序列，定义为：

df <- data.frame(date = as.Date("2016-01-01") + ((1:100) + sample(1:5, 100, replace = TRUE)), 
data = rnorm(100) )

如何使用此衰减函数定义的权重计算 data 列在过去 30 天内的滚动总和？

tau <- 0.05
decay = function(tau, day){
  exp(-tau * day)
}

当天数据的权重为 1，30 天前的数据权重为 decay(0.05, 30) = 0.2231302。在使用衰减函数计算权重时，仍应考虑输入时间序列中缺失的天数。

如果可能，我想将数据框转换为 zoo 或 xts 对象，然后使用 rollapplyr 函数或类似函数，并使用 dplyr 管道。

Answer 1

我不确定管道，但这应该可以让你继续：

d <- decay(tau, 29:0)
rollapply(df, 30, function(z) {
  data <- as.data.frame(z, stringsAsFactors = FALSE)
  data$data <- as.numeric(data$data)
  sum(data$data * d)
}, by.column = FALSE)

Answer 2

定义一个函数 weighted 获取最后 30 个点，并且只保留最后一个点后 30 天内的点。然后使用它们乘以权重。

在管道中，我们将 df 转换为 zoo，然后将 rollapplyr 与 weighted 一起使用。请注意，重要的是我们使用 coredata = FALSE 以便将时间索引传递给 weighted。没有它就不会。

library(dplyr)
library(zoo)

weighted <- function(x, tau) {
  tx <- time(x)
  cx <- coredata(x)[tx > tail(tx, 1) - 30] # only keep if within 30 days
  w <- decay(tau, seq(to = 0, by = -1, length = length(cx)) )
  sum(w * cx)
}

df %>%
  read.zoo %>%
  rollapplyr(30, weighted, tau = tau, partial = TRUE, coredata = FALSE)

如果您想将缺失天数视为 0，请改用此方法：

weighted <- function(x, tau) {
  tx <- as.numeric(time(x))
  days <- tail(tx, 1) - tx
  w <- (days < 30) * decay(tau, days)
  sum(w * coredata(x))
}

备注

我们使用了从问题中修改的以下输入，添加了 set.seed 以实现可重复性。此外，问题中使用的代码可能会偶然产生具有相同 date 的多个值，我们消除了此类重复值。

set.seed(123)
df <- data.frame(date = as.Date("2016-01-01") + 1:100 + sample(1:5, 100, replace = TRUE), 
  data = rnorm(100) )
df <- df[!duplicated(df$date), ]

tau <- 0.05
decay = function(tau, day){
  exp(-tau * day)
}

根据函数计算具有不规则间距的时间序列的加权和

Calculate a weighted sum from a timeseries with irregular spacing based on a function

r

zoo

dplyr

备注