我的试验数据如下:
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)
}}}}
答案 0 :(得分:1)
几个星期前我遇到了这个确切的问题,结果写了并在networkR
包中添加了一个函数。
adjacency
函数使用三个向量来表示{3},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
答案 1 :(得分: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
答案 2 :(得分:1)
如果您愿意使用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
答案 3 :(得分:0)
开发的@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