[英]Creating a correlation matrix from a data frame in R
我有一個相關性數據框,看起來像這樣(盡管我的真實數據中有大約 15,000 行)
phen1<-c("A","B","C")
phen2<-c("B","C","A")
cors<-c(0.3,0.7,0.8)
data<-as.data.frame(cbind(phen1, phen2, cors))
phen1 phen2 cors
1 A B 0.3
2 B C 0.7
3 C A 0.8
這是在外部創建並讀入 R 中,我想將此數據框轉換為相關矩陣,其中 phen1 和 2 作為該矩陣的行和列的標簽。 我只為下三角形或上三角形計算過這個,我沒有對角線的 1。 所以我希望最終結果是一個完整的相關矩陣,但第一步可能是創建下/上三角形,然后轉換為我認為的完整矩陣。 我不確定如何做這一步。
此外,結果可能不是直觀的順序,但我不確定這是否重要,但理想情況下我想要一種方法來做到這一點,它使用 phen1 和 phen 2 中的標簽來確保矩陣具有正確的值在正確的地方,如果這有意義嗎?
基本上為此,我想要這樣的結果作為最終結果:
A B C
A 1 0.3 0.8
B 0.3 1 0.7
C 0.8 0.7 1
我認為必須有一種優雅的方式來做到這一點,但是,這里有一個dplyr
和tidyr
可能性:
data %>%
spread(phen1, cors) %>%
rename(phen = "phen2") %>%
bind_rows(data %>%
spread(phen2, cors) %>%
rename(phen = "phen1")) %>%
group_by(phen) %>%
summarise_all(~ ifelse(all(is.na(.)), 1, first(na.omit(.))))
phen A B C
<chr> <dbl> <dbl> <dbl>
1 A 1 0.3 0.8
2 B 0.3 1 0.7
3 C 0.8 0.7 1
這是 base R 中的另一個,我們創建了一個與data
相同的對稱數據幀,但列倒置為phen1
和phen2
。 然后我們使用xtabs
得到一個相關矩陣並將對角線設置為 1。
data1 <- data.frame(phen1 = data$phen2, phen2 = data$phen1, cors = data$cors)
df <- rbind(data, data1)
df1 <- as.data.frame.matrix(xtabs(cors ~ ., df))
diag(df1) <- 1
df1
# A B C
#A 1.0 0.3 0.8
#B 0.3 1.0 0.7
#C 0.8 0.7 1.0
數據
phen1<-c("A","B","C")
phen2<-c("B","C","A")
cors<-c(0.3,0.7,0.8)
data<- data.frame(phen1, phen2, cors)
您可以為此使用 Matrix 包。 您擁有的是數據的稀疏表示,並且您希望將其轉換為密集(冗余)矩陣。
data <- data.frame(phen1, phen2, cors)
inds <- cbind(as.integer(data$phen1), as.integer(data$phen2))
inds <- t(apply(inds, 1, sort))
library(Matrix)
res <- sparseMatrix(i = inds[,1],
j = inds[,2],
x = data$cors,
symmetric = TRUE)
#3 x 3 sparse Matrix of class "dsCMatrix"
#
#[1,] . 0.3 0.8
#[2,] 0.3 . 0.7
#[3,] 0.8 0.7 .
res <- as.matrix(res)
diag(res) <- 1
dimnames(res) <- list(sort(data$phen1), sort(data$phen2))
res
# A B C
#A 1.0 0.3 0.8
#B 0.3 1.0 0.7
#C 0.8 0.7 1.0
這是另一種選擇。
首先將數據從 long 重新整形為 Wide 並轉換為matrix
。 你有不同的選擇來做到這一點( reshape2
、 tidyr
等); 在這里我使用tidyr::spread
。
library(tidyverse)
mat <- data %>% spread(phen2, cors) %>% column_to_rownames("phen1") %>% as.matrix()
然后我們分別從上三角矩陣和下三角矩陣填充缺失的NA
值,並用1
填充對角線。
mat[lower.tri(mat)] <- mapply(sum, mat[lower.tri(mat)], mat[upper.tri(mat)], na.rm = T)
mat[upper.tri(mat)] <- mat[lower.tri(mat)]
diag(mat) <- 1
mat
# A B C
#A 1.0 0.3 0.8
#B 0.3 1.0 0.7
#C 0.8 0.7 1.0
您可以使用重塑庫。
library(reshape)
data <- melt(data)
your_mat <- cast(data, phen1 ~ phen2 )
輸出:
phen1 A B C
1 A <NA> 0.3 <NA>
2 B <NA> <NA> 0.7
3 C 0.8 <NA> <NA>
您將 NA 的原因是因為您的輸入表中缺少許多組合。 為了避免這種情況,您需要一個這樣的輸入表:
phen1 phen2 cors
1 A B 0.3
2 B C 0.7
3 C A 0.8
4 A C 0.8
5 B A 0.3
6 C B 0.7
7 A A 1.0
8 B B 1.0
9 C C 1.0
已經有很多解決方案,但我會以另一種方式提出。 注意:我正在設置數據,以便cors
是數字而不是原始數據框中的一個因素。
data <- data.frame(phen1, phen2, cors)
然后我們可以擴展缺少組合的數據框,然后使用reshape2::acast()
將數據轉換為寬格式。
library(tidyverse)
library(reshape2)
data %>%
select(phen1 = phen2, phen2 = phen1, cors) %>%
bind_rows(data) %>%
acast(phen1 ~ phen2, fill = 1)
acast
可以acast
地讓您用一些其他指定值填充缺失值,在本例中為 1。
另外,查看corrr
包,它可能可以更巧妙地做到這一點。
這是我寫的一個函數:
long2cormat <- function(xlong, x = "x", y = "y", r = "r") {
# Takes some inspiration from https://stackoverflow.com/a/57904948/180892
xlong <- xlong[,c(x, y, r)]
names(xlong) <- c("x", "y", "r")
data1 <- data.frame(x = xlong$x, y = xlong$y, r = xlong$r)
data2 <- data.frame(x = xlong$y, y = xlong$x, r = xlong$r)
df <- rbind(data1, data2)
uv <- unique(c(df$x, df$y))
df1 <- matrix(NA, nrow = length(uv), ncol = length(uv), dimnames = list(uv, uv))
for (i in seq(nrow(df))) df1[df$x[i], df$y[i]] <- df$r[i]
diag(df1) <- 1
df1
}
要運行它,請執行以下操作:
xlong <- data.frame(phen1 = c("A","B","C"),
phen2 = c("B","C","A"),
cors = c(0.3,0.7,0.8))
long2cormat(xlong, "phen1", "phen2", "cors")
重要的是,對於我自己的用例,它將缺失的相關性保留為 NA。
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.