加權皮爾遜相關系數？

Question

我有一個名為y的2396x34 double matrix其中每行（2396）表示一個由34個連續時間段組成的單獨情況。

我也有一個名為x的numeric[34] ，它表示34個連續時間段的單一情況。

目前，我正在像這樣計算y和x每一行之間的相關性：

crs[,2] <- cor(t(y),x)

我現在需要的是將上述語句中的cor函數替換為加權相關。 權重向量xy.wt是34個元素長，因此可以為34個連續的時間段中的每個分配不同的權重。

我找到了Weighted Covariance Matrix函數cov.wt並認為，如果我首先scale數據，它將像cor函數一樣工作。 實際上，您也可以為函數指定返回相關矩陣。 不幸的是，由於我無法分別提供兩個變量（ x和y ），因此似乎無法以相同的方式使用它。

有人知道我可以以我描述的方式獲得加權相關性而又不犧牲太多速度的方法嗎？

編輯：也許一些數學函數可以在cor函數之前應用於y ，以獲得與我正在尋找的結果相同的結果。 也許我將每個元素乘以xy.wt/sum(xy.wt) ？

編輯＃2我在boot包中發現了另一個函數corr 。

corr(d, w = rep(1, nrow(d))/nrow(d))

d   
A matrix with two columns corresponding to the two variables whose correlation we wish to calculate.

w   
A vector of weights to be applied to each pair of observations. The default is equal weights for each pair. Normalization takes place within the function so sum(w) need not equal 1.

這也不是我所需要的，而是更接近。

編輯＃3這是一些代碼來生成我正在使用的數據類型：

x<-cumsum(rnorm(34))
y<- t(sapply(1:2396,function(u) cumsum(rnorm(34))))
xy.wt<-1/(34:1)

crs<-cor(t(y),x) #this works but I want to use xy.wt as weight

Answer 1

不幸的是，當y是多於一行的矩陣時，可接受的答案是錯誤的。 錯誤在行

vy <- rowSums( w * y * y )

我們希望將y的列乘以w ，但這將使行乘以w的元素，並在必要時回收。 從而

> f(x, y[1, , drop = FALSE], xy.wt)
[1] 0.103021

是正確的，因為在這種情況下，乘法是逐元素進行的，在此等效於逐列乘法，但是

> f(x, y, xy.wt)[1]
[1] 0.05463575

由於按行乘法給出錯誤的答案。

我們可以如下糾正功能

f2 <- function( x, y, w = rep(1,length(x))) {
  stopifnot(length(x) == dim(y)[2] )
  w <- w / sum(w)
  # Center x and y, using the weighted means
  x <- x - sum(x * w)
  ty <- t(y - colSums(t(y) * w))
  # Compute the variance
  vx <- sum(w * x * x)
  vy <- colSums(w * ty * ty)
  # Compute the covariance
  vxy <- colSums(ty * x * w)
  # Compute the correlation
  vxy / sqrt(vx * vy)
}

並對照boot包中的corr產生的結果進行檢查：

> res1 <- f2(x, y, xy.wt)
> res2 <- sapply(1:nrow(y), 
+                function(i, x, y, w) corr(cbind(x, y[i,]), w = w),
+                x = x, y = y, w = xy.wt)
> all.equal(res1, res2)
[1] TRUE

它本身提供了解決該問題的另一種方式。

Answer 2

這是計算兩個矩陣之間的加權皮爾遜相關性的概括（代替原始問題中的向量和矩陣）：

matrix.corr <- function (a, b, w = rep(1, nrow(a))/nrow(a)) 
{
    # normalize weights
    w <- w / sum(w)

    # center matrices
    a <- sweep(a, 2, colSums(a * w))
    b <- sweep(b, 2, colSums(b * w))

    # compute weighted correlation
    t(w*a) %*% b / sqrt( colSums(w * a**2) %*% t(colSums(w * b**2)) )
}

使用上面的示例和Heather的相關函數，我們可以對其進行驗證：

> sum(matrix.corr(as.matrix(x, nrow=34),t(y),xy.wt) - f2(x,y,xy.wt))
[1] 1.537507e-15

在調用語法方面，這類似於未加權的cor ：

> a <- matrix( c(1,2,3,1,3,2), nrow=3)
> b <- matrix( c(2,3,1,1,7,3,5,2,8,1,10,12), nrow=3)
> matrix.corr(a,b)
     [,1]      [,2] [,3]      [,4]
[1,] -0.5 0.3273268  0.5 0.9386522
[2,]  0.5 0.9819805 -0.5 0.7679882
> cor(a, b)
     [,1]      [,2] [,3]      [,4]
[1,] -0.5 0.3273268  0.5 0.9386522
[2,]  0.5 0.9819805 -0.5 0.7679882

Answer 3

您可以返回到相關性的定義。

f <- function( x, y, w = rep(1,length(x))) {
  stopifnot( length(x) == dim(y)[2] )
  w <- w / sum(w)
  # Center x and y, using the weighted means
  x <- x - sum(x*w)
  y <- y - apply( t(y) * w, 2, sum )
  # Compute the variance
  vx <- sum( w * x * x )
  vy <- rowSums( w * y * y ) # Incorrect: see Heather's remark, in the other answer
  # Compute the covariance
  vxy <- colSums( t(y) * x * w )
  # Compute the correlation
  vxy / sqrt(vx * vy)
}
f(x,y)[1]
cor(x,y[1,]) # Identical
f(x, y, xy.wt)