使用tidygraph将来自相同两个节点的两条边合并为一条边

Question

我正在努力弄清楚如何将相同2个节点之间的2条边折叠成1条边，然后计算这些边的总和。

我相信在igraph中有一种方法可以做到：

simplify(gcon, edge.attr.comb = list(weight = "sum", function(x)length(x)))

但如果可能的话，我想用tidygraph来做这件事，因为到目前为止，我已经用tidygraph成功地实现了这一点，而且我更熟悉tidyverse的工作方式。

我的数据如下所示：

  from to Strength Dataframe Question                Topic
1    0 32        4    weekly        1 Connection Frequency
2    0 19        5    weekly        1 Connection Frequency
3    0  8        3    weekly        1 Connection Frequency
4    0  6        5    weekly        1 Connection Frequency
5    0  2        4    weekly        1 Connection Frequency
6    0 14        5    weekly        1 Connection Frequency

其中'from‘和'to’都包含相同的id(例如，from-to；0-1 & 1-0)。我想精简一下，使0-1关系只存在一次迭代，并计算出总和Strength。

到目前为止，我的代码如下：

graph <- data %>%
  filter(Dataframe == "weekly" & Question == 1) %>%
  as_tbl_graph(directed = FALSE) %>%
  activate(edges) %>% # first manipulate edges
  filter(!edge_is_loop()) %>% # remove any loops
  activate(nodes) %>% # now manipulate nodes
  left_join(node.group, by = "name") %>% 
  mutate(
    Popularity = centrality_degree(mode = 'in'),
    Centre = node_is_center(),
    Keyplayer = node_is_keyplayer(k = 5))

可以将两条对应的边合并成一条边吗？我搜索了论坛，但只遇到了相同节点在相同列中重复的引用(即多行中的0-1)。

Answer 1

library(tidygraph) # v1.2.0
library(dplyr) # v0.8.5
library(purrr) # v0.3.4

dat <- data.frame(
  from = c("a", "a", "b", "c"),
  to = c("b", "b", "a", "b"),
  n = 1:4
)

在convert()中调用to_simple()以折叠平行边。相应的边和权重作为碎石列表存储在.orig_data中。然后，从.orig_data中提取折叠边的权重之和。

dat %>% 
  as_tbl_graph() %>% 
  convert(to_simple) %>% 
  activate(edges) %>% 
  mutate(n_sum = map_dbl(.orig_data, ~ sum(.x$n)))

# A tbl_graph: 3 nodes and 3 edges
#
# A directed simple graph with 1 component
#
# Edge Data: 3 x 5 (active)
   from    to .tidygraph_edge_index .orig_data       n_sum
  <int> <int> <list>                <list>           <dbl>
1     1     2 <int [2]>             <tibble [2 x 3]>     3
2     2     1 <int [1]>             <tibble [1 x 3]>     3
3     3     2 <int [1]>             <tibble [1 x 3]>     4
#
# Node Data: 3 x 2
  name  .tidygraph_node_index
  <chr>                 <int>
1 a                         1
2 b                         2
3 c                         3

Answer 2

您可以通过跳转到加权邻接矩阵并返回到图G中来折叠图G中的多条边，如下所示：

gg <- graph.adjacency(get.adjacency(g), mode="undirected", weighted=TRUE)

现在，gg将包含与g中每个顶点对之间出现的边数相对应的边属性$weight。

我对tidygraph不是很熟悉，但我编写这段教学代码是为了让您的学习更轻松。

# A graph from sample data
sample_el <- cbind(c(1,1,1,2,2,2,3,3,3,4,4,5,5,6,6,6,7,7,7,7,8,8),
                   c(2,2,3,6,6,4,4,6,8,5,5,6,8,7,7,2,6,8,3,6,4,4))
g <- graph_from_edgelist(sample_el, directed=F)

# Always plot graphs with this same layout
mylaoyt <- layout_(g, as_star())
plot(g, layout = mylaoyt)

# Merge all duplicate edges using a weighted adjacency matric that
# is converted back to a graph
gg <- graph.adjacency(get.adjacency(g), mode="undirected", weighted=TRUE)

# function to return a weighted edgelist from a graph
get.weighted.edgelist <- function(graph){cbind(get.edgelist(gg), E(gg)$weight)}

# compare your two edge-lists. el has duplicates, wel is weighted
el <- get.edgelist(g)
wel<- get.weighted.edgelist(gg)
el
wel

# Plot the two graphs to see what el and wel would look like:
par(mfrow=c(1,2))
plot(g, layout=mylaoyt, vertex.label=NA, vertex.size=10)
plot(gg, layout=mylaoyt, vertex.label=NA, vertex.size=10, edge.width=E(gg)$weight * 3)

el和wel中的输出如下所示：

​

​

希望你能创造出你所需要的东西。

Answer 3

我也在努力解决这个问题。到目前为止，我的解决方案是折叠每个节点的对，然后将权重相加。如下所示：

require(dplyr)
require(tidyr)

pasteCols = function(x, y, sep = ":"){
  stopifnot(length(x) == length(y))
  return(lapply(1:length(x), function(i){paste0(sort(c(x[i], y[i])), collapse = ":")}) %>% unlist())
}
data = data %>% 
  mutate(col_pairs = pasteCols(from, to, sep = ":")) %>% 
  group_by(col_pairs) %>% summarise(sum_weight = sum(weight)) %>% 
  tidyr::separate(col = col_pairs, c("from", "to"), sep = ":")