使用滚动的小波相关 window

Wavelet correlation using rolling window

我有 3 个时间序列,我可以将小波变换应用于滚动 window。滚动 window 采用长度为 200 的单个时间序列,并在前 30 个样本上对其应用 waveslim::modwt 函数。这会输出 5 个我只感兴趣的列表 (d1,d2,d3,d4),每个列表的长度都是 30。可以在这里找到一个简单的例子:

library(waveslim)
J <- 4 #no. of levels in decomposition
data(ar1)
ar1.modwt <- modwt(ar1, "la8", J)

@G。 Grothendieck 为单个时间序列 .

的滚动 window 方法提供了一段简洁的代码

滚动 window 递增 1,然后我们再次进行,生成另外 5 个列表,其中我只关心 d1->d4 等等,直到时间序列的全长翻车了。

下一步是将 waveslim::brick.wall 函数应用于滚动 window 列表的输出。 brick.wall 函数查看 4 个级别中第一个 window 的 modwt 的输出,并将一些值替换为 NAs。

我相信我已经通过修改@G 解决了这个问题。 Grothendieck 的回答使用了下面的方法,希望我是对的:

modwt2 <- function(...) unlist(head(brick.wall(modwt(...)), 4))
rollr <- rollapplyr(ar1, 30, FUN = modwt2, wf = "la8", n.levels = 4, boundary = "periodic")
L <- lapply(1:nrow(rollr), function(i) matrix(rollr[i,], , 4))

最后一部分是为 brick.wall 函数的输出构建相关矩阵,该函数在 4 个感兴趣级别上 L 以上。

有一个名为 waveslim::wave.correlation 的函数,它采用两个 brick.wall 输出 X 和 Y 并计算各个级别的 wave.correlation

library(waveslim)
data(exchange)
returns <- diff(log(as.matrix(exchange)))
returns <- ts(returns, start=1970, freq=12)
wf <- "la8"
J <- 4
demusd.modwt <- modwt(returns[,"DEM.USD"], wf, J)
demusd.modwt.bw <- brick.wall(demusd.modwt, wf)
jpyusd.modwt <- modwt(returns[,"JPY.USD"], wf, J)
jpyusd.modwt.bw <- brick.wall(jpyusd.modwt, wf)
returns.modwt.cor <- wave.correlation(demusd.modwt.bw, jpyusd.modwt.bw,
                                      N = dim(returns)[1])

我希望对此进行扩展并计算我的 3 个时间序列的完整相关矩阵。请注意,上面的汇率示例没有使用滚动 window 方法,因为它使用了我现在想做的时间序列的完整长度,并且它还为两个时间之间的相关性生成了一个值系列。它没有构建我需要的完整相关矩阵,因为我对这些相关矩阵随时间变化的特征值很感兴趣。

总而言之:

  1. 取 3 个时间序列
  2. 使用滚动应用 modwt 函数 window
  3. brick.wall函数应用于上面2中滚动window的每个输出
  4. 随着时间的推移使用上面 3 的输出为 4 个级别创建完整的 3x3 相关矩阵

将您在问题中给出的各个部分放在一起:

1) 创建3个时间序列

set.seed(1)
s <- replicate(3, rnorm(200), simplify = FALSE)

2) & 3) 滚动应用 modwtbrick.wall window

modwt2 <- function(...) unlist(head(brick.wall(modwt(...), wf = "la8"), 4))

rollr <- lapply(s, function(x) rollapplyr(x, 30, FUN = modwt2, wf = "la8", 
                                          n.levels = 4, boundary = "periodic"))

L <- lapply(rollr, function(x) lapply(1:nrow(x), function(i) matrix(x[i,], , 4)))

res <- lapply(L, function(y) lapply(y, function(x) as.list(as.data.frame(x))))

4) 创建相关矩阵

create_4mat <- function(w) {
  # create four 3*3 correlation matrices (one for each level) for window w
  M <- replicate(4, matrix(0, nrow = 3, ncol = 3), simplify = FALSE)
  for (k in 1:4) {
    for (i in 1:3) {
      for (j in (i:3)[-1]) {
        M[[k]][i, j] = wave.correlation(res[[i]][[w]], res[[j]][[w]], N=30)[k, 1]
      }
    }
    M[[k]] <- M[[k]] + t(M[[k]]) + diag(1, 3, 3)
  }
  M
}

output <- lapply(1:171, create_4mat)

output 是 4 个相关矩阵的 171 个列表的列表。

比如output[[28]][[2]]是第28行d2的相关矩阵window:

output[[28]][[2]]
#            [,1]       [,2]      [,3]
# [1,]  1.0000000 -0.1740320 0.2292872
# [2,] -0.1740320  1.0000000 0.6046918
# [3,]  0.2292872  0.6046918 1.0000000

编辑:特征值(按照评论中的要求)

对于d1

eigenvalues1 <- lapply(output, function(x) eigen(x[[1]], symmetric = TRUE, 
                                                 only.values = TRUE)$values)

d2 类似。请注意,对于 d3d4,所有相关矩阵都填充了缺失值。