给定数据，如何在 R 中创建类似于邻接矩阵的矩阵？

Question

我的试验数据如下：

testdata = matrix(c(1,1,1,2,2,3,3,3,10,11,12,13,
14,15,16,17,28,30,25,40,50,47,62,23),ncol=3,byrow=F)
colnames(testdata)=c("index","contact","age")

testdata
#>      index contact age
#> [1,]     1      10  28
#> [2,]     1      11  30
#> [3,]     1      12  25
#> [4,]     2      13  40
#> [5,]     2      14  50
#> [6,]     3      15  47
#> [7,]     3      16  62
#> [8,]     3      17  23

根据给定的数据，我想创建一个类似于邻接矩阵的矩阵，如下所示。

adjmat = matrix(c(0,0,0,28,30,25,rep(0,11),40,50,
rep(0,11),47,62,23,28, rep(0,10),30,rep(0,10),25, rep(0,11), 40, rep(0,10),50, 
rep(0,11),47, rep(0,10), 62,rep(0,10), 23, rep(0,8)),ncol=11,byrow=T,     
dimnames = list(c("1", "2","3","10","11","12","13","14","15","16","17"),
c("1","2","3","10","11","12","13","14","15","16","17")))

这意味着在矩阵形式中它将如下：

adjmat
#>     1  2  3 10 11 12 13 14 15 16 17
#> 1   0  0  0 28 30 25  0  0  0  0  0
#> 2   0  0  0  0  0  0 40 45  0  0  0
#> 3   0  0  0  0  0  0  0  0 47 62 23
#> 10 28  0  0  0  0  0  0  0  0  0  0
#> 11 30  0  0  0  0  0  0  0  0  0  0
#> 12 25  0  0  0  0  0  0  0  0  0  0
#> 13  0 40  0  0  0  0  0  0  0  0  0
#> 14  0 50  0  0  0  0  0  0  0  0  0
#> 15  0  0 47  0  0  0  0  0  0  0  0
#> 16  0  0 62  0  0  0  0  0  0  0  0
#> 17  0  0 23  0  0  0  0  0  0  0  0

我该怎么做？我尝试了以下 循环，但没有按预期成功。

index=c(1,1,1,2,2,3,3,3)
   contact=c(10,11,12,13,14,15,16,17)
   age=c(28,30,25,40,50,47,62,23)
   row=c(1,2,3,10,11,12,13,14,15,16,17)
   col=c(1,2,3,10,11,12,13,14,15,16,17)
   x=matrix(, nrow=11, ncol=11)

 for (i in 1:length(row)){
     for (j in 1:length(col)){
       for (k in 1:length(index)){
          for (m in 1:length(contact)){
   if(index[k]==row[i] & contact[m]==col[j]) {x[i,j]<- age[k]}
          else {x[i,j]<- 0}   
   print(x)   
     }}}}

Answer 1

Base R 解决方案类似于：

> x<-unique(sort(testdata[,1:2]))
> m=matrix(0,length(x),length(x),dimnames = list(x,x))
> m[cbind(testdata[,1],which(x%in%testdata[,2]))]=testdata[,3]
> m[lower.tri(m)]=t(m)[lower.tri(m)]
> m
    1  2  3 10 11 12 13 14 15 16 17
1   0  0  0 28 30 25  0  0  0  0  0
2   0  0  0  0  0  0 40 50  0  0  0
3   0  0  0  0  0  0  0  0 47 62 23
10 28  0  0  0  0  0  0  0  0  0  0
11 30  0  0  0  0  0  0  0  0  0  0
12 25  0  0  0  0  0  0  0  0  0  0
13  0 40  0  0  0  0  0  0  0  0  0
14  0 50  0  0  0  0  0  0  0  0  0
15  0  0 47  0  0  0  0  0  0  0  0
16  0  0 62  0  0  0  0  0  0  0  0
17  0  0 23  0  0  0  0  0  0  0  0

Answer 2

如果你愿意使用igraph包it can be done relatively easily，

# install.packages(c("igraph"), dependencies = T)
require(igraph)
g <- graph.data.frame(testdata, directed=F, vertices=NULL)
m <- as_adjacency_matrix(g, attr = "age", sparse = F)
identical(m, adjmat)
#> [1] TRUE
m
#>     1  2  3 10 11 12 13 14 15 16 17
#> 1   0  0  0 28 30 25  0  0  0  0  0
#> 2   0  0  0  0  0  0 40 50  0  0  0
#> 3   0  0  0  0  0  0  0  0 47 62 23
#> 10 28  0  0  0  0  0  0  0  0  0  0
#> 11 30  0  0  0  0  0  0  0  0  0  0
#> 12 25  0  0  0  0  0  0  0  0  0  0
#> 13  0 40  0  0  0  0  0  0  0  0  0
#> 14  0 50  0  0  0  0  0  0  0  0  0
#> 15  0  0 47  0  0  0  0  0  0  0  0
#> 16  0  0 62  0  0  0  0  0  0  0  0
#> 17  0  0 23  0  0  0  0  0  0  0  0

Answer 3

几周前我遇到了这个确切的问题，最终在networkR 包中编写并添加了一个函数。

adjacency 函数采用三个向量表示 from、to 和 weight，它们对应于您的三列。参数directed=FALSE 设置为使输出对称。

library(networkR)
testdata = matrix(c(1,1,1,2,2,3,3,3,10,11,12,13,
                    14,15,16,17,28,30,25,40,50,47,62,23),ncol=3,byrow=F)

result <- adjacency(from=testdata[,1], 
                    to=testdata[,2], 
                    weight=testdata[,3], directed=FALSE)

result

返回一个稀疏矩阵，输出如下。

11 x 11 sparse Matrix of class "dsCMatrix"

 [1,]  .  .  . 28 30 25  .  .  .  .  .
 [2,]  .  .  .  .  .  . 40 50  .  .  .
 [3,]  .  .  .  .  .  .  .  . 47 62 23
 [4,] 28  .  .  .  .  .  .  .  .  .  .
 [5,] 30  .  .  .  .  .  .  .  .  .  .
 [6,] 25  .  .  .  .  .  .  .  .  .  .
 [7,]  . 40  .  .  .  .  .  .  .  .  .
 [8,]  . 50  .  .  .  .  .  .  .  .  .
 [9,]  .  . 47  .  .  .  .  .  .  .  .
[10,]  .  . 62  .  .  .  .  .  .  .  .
[11,]  .  . 23  .  .  .  .  .  .  .  .

Answer 4

@ekstroem 开发的函数可能更灵活，但您不需要任何循环来创建矩阵：

testdata <- matrix(c(1,1,1,2,2,3,3,3,10,11,12,13,
    14,15,16,17,28,30,25,40,50,47,62,23), ncol=3, 
    byrow=FALSE)
colnames(testdata)=c("index","contact","age")

rc <- unique(c(testdata[, 1:2]))
adjmat <- matrix(0, length(rc), length(rc), dimnames=list(rc, rc))
idx1 <- match(testdata[, 1], rc)
idx2 <- match(testdata[, 2], rc)
adjmat[cbind(idx1, idx2)] <- testdata[, 3]
adjmat[cbind(idx2, idx1)] <- testdata[, 3]
adjmat

给你以下结果：

    1  2  3 10 11 12 13 14 15 16 17
1   0  0  0 28 30 25  0  0  0  0  0
2   0  0  0  0  0  0 40 50  0  0  0
3   0  0  0  0  0  0  0  0 47 62 23
10 28  0  0  0  0  0  0  0  0  0  0
11 30  0  0  0  0  0  0  0  0  0  0
12 25  0  0  0  0  0  0  0  0  0  0
13  0 40  0  0  0  0  0  0  0  0  0
14  0 50  0  0  0  0  0  0  0  0  0
15  0  0 47  0  0  0  0  0  0  0  0
16  0  0 62  0  0  0  0  0  0  0  0
17  0  0 23  0  0  0  0  0  0  0  0