[英]Correlation coefficient from randomised variables in R
我的目標是獲得一個新的相關變量(斯皮爾曼的)系數,其中每個數字對應於兩個隨機變量之間的相關性。
例如
var1=c(1, 2, 3, 0, 2)
var2=c(3, 6, 0, 1, 2)
我試過了
set.seed(1)
f1=numeric(10000)
for (i in 1:10000) {rand <- replicate(10000, sample(var1))
rand1 <- replicate(10000, sample(var2))
f1[i]=cor(rand, rand1, use ="everything", method=c("spearman"))
}
這給了我這個消息:警告消息:在 f1[i]=cor(rand, rand1, use = "everything", method = c("spearman")): 要替換的項目數不是替換長度的倍數
我試過這個:
cof <- cor((replicate(1000, sample(var1))), (replicate(1000, sample(var2))), use ="everything", method=c("spearman"))
它返回每個值的相關系數矩陣,而不是每個變量
或者,如果有一種方法可以讓 R 將一個數據幀中的第 1 行與另一個數據幀中的第 1 行關聯起來,然后到第 2 行,然后到第 3 行等,我可以得到我的隨機變量的矩陣:
set.seed(1)
f1=numeric(10000)
for (i in 1:10000) {rand <- replicate(10000, sample(var1))
rand1 <- replicate(10000, sample(var2))
}
然后我必須相互關聯
有沒有辦法在每對隨機變量生成時計算它們之間的相關系數,然后為每個隨機化創建一個由相關系數組成的新變量?
謝謝
我不完全確定我理解你試圖做什么。 也許這會解決你的問題:
var1=c(1, 2, 3, 0, 2)
var2=c(3, 6, 0, 1, 2)
set.seed(1)
n=100
rand <- replicate(n, sample(var1))
rand1 <- replicate(n, sample(var2))
# That is maybe what you are searching for
f1 <- apply(rand,2,cor,rand1)
您將有一個n xn矩陣,其中每個( i, j )表示 rand 的第i列和 rand1 的第j列之間的相關性。
我認為你應該更容易只使用實際的斯皮爾曼相關公式,而不使用 cor()。
這看起來像這樣:
spearman<-function(x,y){
X<-as.matrix(x)
Y<-as.matrix(y)
y<-rowSums(X)
a<-rowSums(Y)
spearman<-2*cor(y,a)/(1+cor(y,a))
return(spearman)
}
運行后,您可以使用
spearman(data1$firstrow,data2$secondrow)
計算所需的相關性。
然后我猜你可以使用這樣的循環:
for (i in nrow(dat)) {
for (i in nrow(dat)) {
correlation<-spearman(datmat[i,],datmat2[i,])
print(correlation[i])
}
}
關於您的第二個問題,您的rand
和rand1
矩陣似乎有 5 行和許多列,並且您想將rand
的每一列與rand1
的等效列相關聯? 如果我猜對了,您可以使用cor.test
來獲取 spearman 等級相關性,例如在循環中。 由於這相對較慢,您還可以以矢量化形式重寫 Spearman 等級相關性的公式並使用它(見下文)。 如果您對逐行相關感興趣,則可以輕松調整或轉置矩陣。
var1=c(1, 2, 3, 0, 2)
var2=c(3, 6, 0, 1, 2)
set.seed(1)
n=10000
rand <- replicate(n, sample(var1))
rand1 <- replicate(n, sample(var2))
library(matrixStats)
colwiseSpearman <- function(m1, m2, correct=TRUE){
require(matrixStats)
n <- dim(m1)[2]
l <- dim(m1)[1]
if (correct){
Txy <- t(sapply(seq_len(n), function(x){
t0 <- tabulate(rand[,x])
t1 <- tabulate(rand1[,x])
return(c(Tx=sum(t0^3-t0)/12, Ty=sum(t1^3-t1)/12))
}))
return(((l^3-l)/6 - rowSums((colRanks(rand, ties.method="average")-colRanks(rand1, ties.method="average"))^2) - Txy[,1] - Txy[,2])/sqrt(((l^3-l)/6 - 2*Txy[,1])*((l^3-l)/6 - 2*Txy[,2]))) # Spearman cor.coeff. corrected for ties
} else {
return(1-(6*rowSums((colRanks(rand, ties.method="average")-colRanks(rand1, ties.method="average"))^2) / (l^3-l)))}
}
library(microbenchmark)
microbenchmark(a=colwiseSpearman(rand, rand1),
b=as.numeric(sapply(seq_len(n), function(x) cor.test(rand[,x], rand1[,x], method="spearman")$estimate)), times=10L )
#> Unit: milliseconds
#> expr min lq mean median uq max neval cld
#> a 65.47719 68.06543 74.83393 69.2682 72.90266 109.9133 10 a
#> b 2769.97084 2789.39907 2826.01399 2821.6867 2849.08012 2880.5115 10 b
a <- colwiseSpearman(rand, rand1)
b <- as.numeric(sapply(seq_len(n), function(x) cor.test(rand[,x], rand1[,x], method="spearman")$estimate))
all.equal(a, b)
#> [1] TRUE
由reprex package (v0.3.0) 於 2020 年 5 月 3 日創建
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.