R:网络分析 - 操纵邻接矩阵以获得"公共链接"矩阵

时间:2018-02-27 16:27:57

标签: r igraph social-networking adjacency-matrix statnet

我正在使用igraph R包进行一些网络分析。

我必须操纵定向加权邻接矩阵(从 igraph 对象中提取函数_as_adjacency_matrix(...)_,以获得不同的矩阵,考虑两个节点彼此共享的传入链接的数量和权重。

假设4个节点:节点 A 连接到节点 C ,节点 B 连接到 A ,节点 C 连接到节点 A B ,节点 D 连接到 A 所有链接都将被指示。

在此设置中, A B 共享来自 C 的内向链接,但没有其他节点共享任何传入链接。

因此,我想创建一个能够从原始列表中创建有向加权邻接列表的例程,其中每个条目[i,j]表示传入边缘值的总和节点i,j彼此共享。

结果必须是一个对称的逻辑矩阵(只有真/假值),位于结果"公共链接的前面。相反指向的邻接矩阵。

回到我的例子,只有条目[ A B ]和[ B A ]应该有一个非零值,等于共享连接节点的内边缘值([ A B ]应该包含[ C < / em> - &gt; A ]值,而[ B A ]应该包含[ C - &gt; B ]值)。

非常感谢任何有关它的建议

1 个答案:

答案 0 :(得分:0)

有趣但有点模糊定义的问题。我在理解你想要的输出时遇到了一些麻烦,但我想我明白了。我在下面的第一次尝试中留下了代码。您提供的示例数据我称之为g

无论哪种方式,我认为你可以从这个代码示例中继续下去。我非常愿意以更聪明的方式做到这一点而没有速度循环,但这是我能想到的最教学的代码,因为我不确定所需的输出。

如果我正确理解了您的问题,您要求的内容将在列表ul中输出,其中ul[[x]][[3]]包含图表的E(),其中边缘从节点i(ul[[x]][[1]])到i和j中的每个节点共享图g中的传入链接。

library(igraph)

# Assume 4 nodes:
# - node A is connected to node C,
# - node B is connected to A,
# - node C is connected to node A and B,
# - node D connected to A
m <- matrix(ncol=4,c(0,0,1,0,
            1,0,0,0,
            1,1,0,0,
            1,0,0,0), byrow=T)
colnames(m) <- rownames(m) <-  c("A","B","C","D")

# Uncomment this stuff to use random network instead
# g <- erdos.renyi.game(n=12, 16, type="gnm", directed=TRUE, loops=FALSE)
# m <- as.matrix(as_adjacency_matrix(g))

# Check that the data is ok
graph_from_adjacency_matrix(m, mode="directed")
g <- graph_from_adjacency_matrix(m, mode="directed")

# Directed weighted adjacency list from the original one, where
# each entry [i,j] represents the sum of the value of incoming
# edge that node i,j share with each other.


# I first missunderstood your question and wrote this output

# This output will be an edgelist containing node-pairs i and j and
# the strength related to the number of other nodes whith which they
# share incoming links.
el <- matrix(ncol=3, nrow=0)
colnames(el) <- c("i","j","strength")

# I then reread your question and made this output containing a list
# wehre every node-pair which share incoming links from the same nodes
# contain the E()-object of igraph-edges from i to each of the nodes
# from which both i and j recieve incoming links in the graph g.
ul <- list()

# Use the empty graph like g to build edgelists
temp.g <- g %>% delete_edges(E(g)) # an empty graph

for(i in V(g)){
    for(j in V(g)){
        # Each node pair is i j for every node in g
        if(i == j){next}


        # Neighborhod() lists linked nodes, in this case at the distance
        # of exactly 1 (mindist and order) for node x using the "in"-coming
        # links:
        in.to.i <- neighborhood(g, order=1, nodes=i, mode="in", mindist=1)
        in.to.j <- neighborhood(g, order=1, nodes=j, mode="in", mindist=1)

        # These are the nodes which all link to both i and j
        shared.incoming <- intersect(in.to.i[[1]], in.to.j[[1]])

        # Make a new graph (gg) with links from each node FROM which i and j both
        # share incoming ties in g TO  i.
        # In the edgelist ul, each row can be read like:
        # In graph g, "i" has "edges" incoming ties in common with "j"
        gg <- temp.g %>% add_edges(unlist(lapply(shared.incoming, function(x) c(x,i)) ))

        # E(gg) is what you want. Add it to the output-list
        ul[[length(ul)+1]] <- list(i, j, as_edgelist(gg, names=T))

        # how many nodes link to both i and j?
        el <- rbind(el,c("i"=i, "j"=j, "edges"=length(shared.incoming) ) )
    }
}

# The whole list of el contains all possible pairs
el

# Strip entries in the edgelist where a pair of nodes don't share any
# in-linking nodes at all
el <- el[el[,'strength'] != 0,  ]

# Since nodes that share in-linking nodes are ALWAYS structually equivilent
# in that they both share in-links from the same other nodes, there is never
# any idea to have this edge-list directed.
# Make the edge-list one-directed by deleting duplicate pairs
el <- el[el[,'i'] < el[,'j'],  ]

# In graph g, these node-pairs share the number of [strength] incoming links
# from the same other nodes.
(el)


# The whole list of ul contains all possible pairs
ul

# You only wanted the pairs which actually contained any shared incoming nodes
keep.from.ul <- unlist(lapply(ul, function(x) ifelse( nrow(x[[3]]) > 0, TRUE, FALSE) ))
ul <- ul[keep.from.ul]