plyr 应用程序，创建一个矩阵列表，每个矩阵对应于数据的一个子集

Question

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

我猜 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

Answer 1

查看SNA package 以及as.edgelist.sna() 和as.sociomatrix.sna() 函数。

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

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

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

Answer 2

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

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()