如何从 R 中本质上非数字的原始数据计算邻接矩阵?

How to calculate adjacency matrix from raw data which is non-numeric in nature in R?

我有不同人同时在不同大学工作的原始数据,例如:

                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

我尝试使用包 reshape 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....),转换不成功。请帮忙。

一种可能的解决方案,假设 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) 创建一个逻辑矩阵来描述数据是否缺失(在内部这相当于 0 和 1)。然后计算叉积。您可以使用赋值 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)