Tương quan của Pearson có trọng số?

Question

Tôi có một 2396x34 double matrix tên là y trong đó mỗi hàng (2396) đại diện cho một tình huống riêng biệt bao gồm 34 phân đoạn thời gian liên tiếp.

Tôi cũng có một numeric[34] có tên x đại diện cho một tình huống duy nhất gồm 34 phân đoạn thời gian liên tiếp.

Hiện nay tôi đang tính toán tương quan giữa mỗi hàng trong y và x như thế này:

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

Những gì tôi cần bây giờ là để thay thế cho cor chức năng trong tuyên bố trên với một trọng tương quan. Trọng số vector xy.wt dài 34 phần tử sao cho trọng số khác nhau có thể được gán cho mỗi trong số 34 phân đoạn thời gian liên tiếp.

Tôi đã tìm thấy hàm Weighted Covariance Matrixcov.wt và nghĩ rằng nếu tôi lần đầu tiên scale dữ liệu sẽ hoạt động giống như chức năng cor. Trong thực tế, bạn có thể chỉ định cho hàm trả về một ma trận tương quan. Thật không may, nó không có vẻ như tôi có thể sử dụng nó trong cùng một cách vì tôi không thể cung cấp hai biến của tôi (x và y) một cách riêng biệt.

Có ai biết cách tôi có thể có được mối tương quan trọng theo cách tôi mô tả mà không bị mất tốc độ không?

Chỉnh sửa: Có thể một số hàm toán học có thể được áp dụng cho y trước khi có chức năng cor để nhận được kết quả tương tự mà tôi đang tìm kiếm. Có lẽ nếu tôi nhân mỗi phần tử với xy.wt/sum(xy.wt)?

Chỉnh sửa # 2 Tôi tìm thấy một hàm khác corr trong gói boot.

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. 

Đây cũng không phải là những gì tôi cần nhưng nó gần hơn.

Sửa # 3 Dưới đây là một số mã để tạo ra các kiểu dữ liệu tôi đang làm việc với:

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

Bạn có thể quay trở lại định nghĩa của tương quan.

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) 

Answer 2

Thật không may câu trả lời được chấp nhận là sai khi y là ma trận của nhiều hàng. Lỗi này là trong dòng

vy <- rowSums(w * y * y) 

Chúng tôi muốn nhân các cột của y bởi w, nhưng điều này sẽ nhân lên các hàng bởi các yếu tố của w, tái chế khi cần thiết.Như vậy

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

là đúng, bởi vì trong trường hợp này được thực hiện nhân tố khôn ngoan, đó là tương đương với phép nhân cột khôn ngoan ở đây, nhưng

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

đưa ra một câu trả lời sai do row- khôn ngoan nhân.

Chúng tôi có thể sửa các chức năng như sau

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) 
} 

và kiểm tra kết quả đối với những sản xuất bởi corr từ boot gói:

> 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 

mà bản thân nó mang lại cho một cách khác rằng vấn đề này có thể là giải quyết.

Answer 3

Đây là một sự tổng quát để tính toán tương quan Pearson trọng giữa hai ma trận (thay vì một vector và ma trận, như trong câu hỏi ban đầu):

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))) 
} 

Sử dụng ví dụ trên và chức năng tương quan từ Heather , chúng ta có thể xác minh nó:

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

về gọi cú pháp, điều này tương tự như không trọng số 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