加权皮尔逊的相关性?

Mik*_*der 13 r correlation weighted

我有一个2396x34 double matrix名字,y其中每一行(2396)代表一个由34个连续时间段组成的单独情况.

我还有一个numeric[34]名称x代表34个连续时间段的单一情况.

目前我正在计算每一行之间的相关性y,x如下所示:

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

我现在需要的是cor加权相关替换上述语句中的函数.权重向量xy.wt是34个元素长,因此可以为34个连续时间段中的每一个分配不同的权重.

我找到了这个Weighted Covariance Matrix函数,cov.wt并认为如果我第scale一个数据它应该像cor函数一样工作.实际上,您也可以为函数指定返回相关矩阵.不幸的是,似乎我不能以相同的方式使用它,因为我无法单独提供我的两个变量(xy).

有没有人知道我可以在不牺牲太多速度的情况下以我描述的方式获得加权相关的方法?

编辑:也许某些数学函数可以应用于函数y之前,cor以获得我正在寻找的相同结果.也许如果我将每个元素乘以xy.wt/sum(xy.wt)

编辑#2corrboot包中找到了另一个功能.

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.
Run Code Online (Sandbox Code Playgroud)

这也不是我需要的,但它更接近.

编辑#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
Run Code Online (Sandbox Code Playgroud)

Hea*_*ner 23

不幸的是,当y一个多行的矩阵时,接受的答案是错误的.错误在行中

vy <- rowSums( w * y * y )
Run Code Online (Sandbox Code Playgroud)

我们想要乘以yby 的列w,但这会将行乘以元素w,并根据需要进行回收.从而

> f(x, y[1, , drop = FALSE], xy.wt)
[1] 0.103021
Run Code Online (Sandbox Code Playgroud)

是正确的,因为在这种情况下,乘法是按元素执行的,这相当于此处的逐列乘法,但是

> f(x, y, xy.wt)[1]
[1] 0.05463575
Run Code Online (Sandbox Code Playgroud)

由于行方式的乘法,给出了错误的答案.

我们可以按如下方式纠正功能

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)
}
Run Code Online (Sandbox Code Playgroud)

和核查一下由所产生的结果corr从所述boot包:

> 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
Run Code Online (Sandbox Code Playgroud)

这本身就提供了解决这个问题的另一种方式.


Vin*_*ynd 4

您可以回到相关性的定义。

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)
Run Code Online (Sandbox Code Playgroud)