如何從R中本質上非數字的原始數據計算鄰接矩陣？

Question

我同時擁有不同人在不同大學工作的原始數據，例如：

                UniA  UniB  UniC  UniD
individual_A    X     NA     X     NA
individual_B    NA     X     NA     X
individual_C    NA     X     NA    NA
individual_D    X      X      X    NA

我嘗試使用這些數據在大學之間建立加權的非直接網絡。 換句話說，我想生成一個與下面給出的示例相對應的鄰接矩陣：

       UniA UniB UniC UniD
UniA     0    1    2    0
UniB          1    1    1
UniC               0    0 
UniD                    0

在R中這怎么可能。任何提示或指針將不勝感激。

預先感謝您的時間和幫助。

---

編輯：您可以幫助重塑數據

              position1   position2  position3 position4
individual_A   UniA        UniC          NA       NA
individual_B   UniB        UniD          NA       NA
individual_C   UniB        NA            NA       NA
individual_D   UniA        UniB          UniC     NA

我嘗試使用包重塑melt（）和cast（）將數據轉換為我之前顯示的形式：

                UniA  UniB  UniC  UniD
individual_A    X     NA     X     NA
individual_B    NA     X     NA     X
individual_C    NA     X     NA    NA
individual_D    X      X      X    NA

但是，原始數據中的值實際上是字符串（uniA / uniB ....），轉換不成功。 請幫忙。

Answer 1

一個可能的解決方案，假設UniB對角線值為零，而不是一個。

數據

dat = read.table(header=T, text="                UniA  UniB  UniC  UniD
individual_A    X     NA     X     NA
individual_B    NA     X     NA     X
individual_C    NA     X     NA    NA
individual_D    X      X      X    NA")

計算

out <- crossprod(!is.na(dat))
diag(out) <- 0

如果您希望下三角為零

out[lower.tri(out)] <- 0

說明

!is.na(dat)創建一個邏輯矩陣，該矩陣描述數據是否丟失（內部等效於零和一）。 然后，您可以計算叉積。 您可以使用assign diag(dat) <-覆蓋對角線值。

---

好吧，關於您的評論，似乎有兩個過程用於填充鄰接矩陣。 1）非對角線記錄了參加每一對大學的人數。2）如果對角線是唯一一個由個人參加的大學，則對角線標記為非零（盡管可以有多個人參加）。 我已經假設它所需要的價值是擁有它作為唯一出席者的人數。

所以從前跟隨

d <- !is.na(dat)
out <- crossprod(d)
diag(out) <- 0

id <- rowSums(d)==1 # which individuals only attend one uni
mx <- max.col(d, "first")  # if there is only one attended which uni?
tab <- table(mx[id])
diag(out)[as.numeric(names(tab))] <- tab
out
#     UniA UniB UniC UniD
#UniA    0    1    2    0
#UniB    1    1    1    1
#UniC    2    1    0    0
#UniD    0    1    0    0

---

重塑您的數據

library(reshape2) 
dat$id <- rownames(dat) 
m <- melt(dat, id="id", na.rm=TRUE)[-2] 
 table(m)