0

在一些帮助下，我想出了如何将边缘列表（也称为邻接列表）转换为邻接矩阵。 我想学习如何为大量边缘列表自动执行此操作，然后将生成的邻接矩阵放入列表中。

我猜 plyr 是做到这一点的最好方法，但如果你想告诉我如何使用循环来做到这一点，我也将不胜感激。对于好奇的人来说，这些数据代表了不同学校的社交网络。

这是我到目前为止所得到的：

     # extract one school edgelist from the dataframe
aSchool <- myDF[which(myDF$school==1), c("school", "id", "x1","x2","x3","x4","x5","x6","x7","x8","x9","x10")]

     # figure out unique ids
edgeColumns <- c("x1","x2","x3","x4","x5","x6","x7","x8","x9","x10")
ids <- unique(unlist(aSchool[edgeColumns]))
ids <- ids[!is.na(ids)]
     # make an empty matrix
m <- matrix(0,nrow=length(ids),ncol=length(ids))
rownames(m) <- colnames(m) <- as.character(ids)
     # fill in the matrix
for(col in edgeColumns){
       theseEdges <- aSchool[c("id",col)]
       theseEdges <- na.omit(theseEdges)
       theseEdges <- apply(theseEdges,1,as.character)
       theseEdges <- t(theseEdges)
       m[theseEdges] <- m[theseEdges] + 1
}
for(i in 1:nrow(m)) m[i,i] <- 0
4

2 回答 2

2

查看SNA 包和as.edgelist.sna()andas.sociomatrix.sna()函数。

特别是，as.sociomatrix.sna()这里似乎是完美的解决方案：它旨在一步将边缘列表转换为邻接矩阵（不会丢失顶点名称等属性）。把这一切都放在一个电话中lapply()，我认为你已经得到了另一个（也许是劳动密集型的？）解决方案。

如果您想看到更具表现力的答案，我认为提供更完整的示例数据或更清晰地描述确切的内容会很有帮助myDF

此外，我没有这样做的声誉，但我会在这篇文章中添加一些标签以表明它是关于网络分析的。

于 2011-02-25T03:43:28.200 回答
1

如果没有一个可行的例子，很难回答你的问题。但是，如果我正确理解了您的问题，这里应该是一个可以工作的函数（返回一个包含对称邻接矩阵的列表）：

makeADJs <- function(...)
{
require(plyr)
dfs <- list(...)

e2adj <- function(x)
{
    IDs <- unique(c(as.matrix(x)))
    df <- apply(x,2,match,IDs)
    adj <- matrix(0,length(IDs),length(IDs))
    colnames(adj) <- rownames(adj) <- IDs
    a_ply(rbind(df,df[,2:1]),1,function(y){adj[y[1],y[2]] <<- 1})
    return(adj) 
}
llply(dfs,e2adj)
}

例子：

makeADJs(
    cbind(letters[sample(1:26)],letters[sample(1:26)]),
    cbind(letters[sample(1:26)],letters[sample(1:26)]),
    cbind(letters[sample(1:26)],letters[sample(1:26)]),
    cbind(letters[sample(1:26)],letters[sample(1:26)])
    )

编辑：

或没有plyr：

makeADJs <- function(...)
{
    dfs <- list(...)
    e2adj <- function(x)
    {
        IDs <- unique(c(as.matrix(x)))
        df <- apply(x,2,match,IDs)
        adj <- matrix(0,length(IDs),length(IDs))
        colnames(adj) <- rownames(adj) <- IDs
        apply(rbind(df,df[,2:1]),1,function(y){adj[y[1],y[2]] <<- 1})
        return(adj) 
    }
    lapply(dfs,e2adj)
}

编辑2：

并将它们全部绘制在一个 pdf 文件中：

library(qgraph)
pdf("ADJplots.pdf")
l_ply(adjs,function(x)qgraph(x,labels=colnames(x)))
dev.off()
于 2011-02-25T01:24:42.633 回答