跨多個列滾動相關性，一些列帶有 NA？

Question

我有以下數據集，我試圖在 x、y、z、a 之間進行 3 天的滾動相關。 所以代碼應該做 xy,xz,xa, yx, yz,ya 等的滾動相關。 此外，正如您在下面看到的，y 和 a 的數據不完整，但我希望從它們第一次擁有值的日期（即 id 3 和 id 4）開始對它們進行滾動相關。

我應該如何做到這一點？ 不知道從哪里開始...

set.seed(42) 
n <- 10
dat <- data.frame(id=1:n, 
                  date=seq.Date(as.Date("2020-12-22"), as.Date("2020-12-31"), "day"),
                  x=rnorm(n),
                  y=rnorm(n),
                  z=rnorm(n),
                  a=rnorm(n))
dat$y[1:2] <- NA
dat$a[1:3] <- NA

我能夠從堆棧中找到這組代碼，但它只能幫助找到第一列而不是所有列的答案

rollapplyr(x, 5, function(x) cor(x[, 1], x[, -1]), by.column = FALSE)

Answer 1

combn產生所有的組合。

cols <- c("x", "y", "z", "a")

combn(cols, 2)
#     [,1] [,2] [,3] [,4] [,5] [,6]
# [1,] "x"  "x"  "x"  "y"  "y"  "z" 
# [2,] "y"  "z"  "a"  "z"  "a"  "a" 

combn有一個函數參數，您首先na.omit所有帶有NA's行。 然后在遞增序列上以1:3 mapply子集並計算相關性，直到達到nrow 。

w <- 3  ## size of the rolling window
combn(dat[cols], 2, function(x) {
  X <- na.omit(x)
  n <- nrow(X)
  mapply(function(y, z) cor(X[y + z, 1], X[y + z, 2]), list(1:w), 0:(n - w))
}, simplify=FALSE)
# [[1]]
# [1]  0.5307784 -0.9874843 -0.8364802  0.2407730  0.3655328 -0.4458231
# 
# [[2]]
# [1]  0.8121466  0.9652715  0.3304100  0.8278965 -0.1425097  0.5832558  0.9959705
# [8]  0.8696023
# 
# [[3]]
# [1]  0.6733985  0.2194488  0.5593983 -0.6589249 -0.9291184
# 
# [[4]]
# [1]  0.97528684 -0.90599558 -0.42319742  0.92882443  0.28058418  0.05427966
# 
# [[5]]
# [1] -0.7815678 -0.7182037 -0.6698260  0.4592962  0.7452225
# 
# [[6]]
# [1]  0.9721521  0.9343926 -0.3470329 -0.7237291 -0.6253825

Answer 2

創建一個僅包含所需列的數據框，然后將rollapplyr與cor rollapplyr使用。 cor采用use=參數，指定如何處理缺失值。 請參閱?cor了解它可以采用的值，因為您可能希望也可能不希望使用我們在下面使用的值。

結果r是一個矩陣，其第 i 行描述了以第i行結尾並包括第i行的 5 個dat2行的相關矩陣。 也就是說， matrix(r[i, ], 4, 4) 是dat2[i-(4:0), ]的相關矩陣。

我們還可以創建ar ，它是一個 3d 數組，其中ar[i,,]是 dat2 的 5 行的相關矩陣，以行i結尾並包括行i 。

也就是說，對於 5, ..., nrow(dat2) 中的每個 i，這些都是相等的。 （r 的前 4 行都是 NA，因為不存在通向這些行的 5 行。）

1. cor(dat2[i-(4:0), ], use = "pairwise")
2. matrix(r[i, ], 4, 4)
3. ar[i,,]

我們在下面對 i=5 的這些等價進行檢查。

library(zoo)
w <- 5
dat2 <- dat[c("x", "y", "z", "a")]
nr <- nrow(dat2)
nc <- ncol(dat2)


r <- rollapplyr(dat2, w, cor, use = "pairwise", by.column = FALSE, fill = NA)
colnames(r) <- paste(names(dat2)[c(row(diag(nc)))], 
                     names(dat2)[c(col(diag(nc)))], sep = ".")

ar <- array(r, c(nr, nc, nc), 
  dimnames = list(NULL, names(dat2), names(dat2)))

# run some checks

cor5 <- cor(dat2[1:w, ], use = "pairwise") # cor of 1st w rows

# same except for names
all.equal(unname(cor5), matrix(r[w, ], nc))
## [1] TRUE

all.equal(cor5, ar[w,,])
## [1] TRUE

上面顯示了一個矩陣，其行串出相關矩陣和一個 3d 數組，其切片是相關矩陣。 輸出的另一種可能性是創建相關矩陣列表。

lapply(1:nr, function(i) {
  if (i >= w) cor(dat2[i-((w-1):0), ], use = "pairwise")
})