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

Question

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

我相信igraph中有一种方法可以实现：

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

但是我想尽可能地使用tidygraph，因为我已经成功地使用tidygraph实现了这一点，并且我对{{1} }的工作方式。

我的数据如下：

tidyverse

其中“ from”和“ to”都包含相同的ID（例如from-to； 0-1和1-0）。我想进行压缩，以便仅存在0-1关系的一次迭代，并计算出总和 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 。

到目前为止，这是我的代码：

Strength

是否可以将两个对应的边合并为一个边？我已经搜索了该论坛，但只遇到了在同一列中重复相同节点（即在多行中为0-1）的引用。

Answer 1

我也在这个问题上苦苦挣扎。 到目前为止，我的解决方案是折叠每个节点对，然后对权重求和。 像这样：

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 = ":")

Answer 2

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
)

在to_simple()中调用convert()折叠平行边。相应的边和权重作为小标题列表存储在.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 3

您可以通过跳到加权邻接度量并返回到igraph图来折叠图g中的多个边，如下所示：

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

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

我对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 4

这是一种方法。它使用tidygraph，在后台使用igraph。

library(tidygraph)
#> 
#> Attaching package: 'tidygraph'
#> The following object is masked from 'package:stats':
#> 
#>     filter
library(igraph)
#> 
#> Attaching package: 'igraph'
#> The following object is masked from 'package:tidygraph':
#> 
#>     groups
#> The following objects are masked from 'package:stats':
#> 
#>     decompose, spectrum
#> The following object is masked from 'package:base':
#> 
#>     union
library(ggraph)
#> Loading required package: ggplot2
library(tidyverse)


g <- tibble(from = sample(letters[1:5], 25, T), 
       to = sample(letters[1:5], 25, T)) %>% 
  as_tbl_graph()



ggraph(g)+
  geom_edge_parallel(arrow = arrow(type = 'closed'), 
                     start_cap = circle(7.5, 'mm'), 
                     end_cap = circle(7.5, 'mm'))+
  geom_node_label(aes(label = name))+
  labs(title = 'Multiple edges shown between node pairs')
#> Using `stress` as default layout

# Add the weigths as counts in the original dataframe

g_weights <- g %>% 
  activate(edges) %>% 
  as_tibble() %>% 
  mutate(link = glue::glue('{from}_{to}')) %>% 
  add_count(link) %>% 
  distinct(link, n, .keep_all = T) %>% 
  select(from, to, n) %>% 
  as_tbl_graph()

ggraph(g_weights)+
  geom_edge_parallel(arrow = arrow(type = 'closed'), 
           start_cap = circle(7.5, 'mm'), 
           end_cap = circle(7.5, 'mm'), 
           aes(width = n))+
  geom_node_label(aes(label = name))+
  labs(title = 'Single edges shown between node pairs', 
       subtitle = 'Weights used as edge width')+
  scale_edge_width(range = c(.5, 2), name = 'Weight')
#> Using `stress` as default layout

^{由reprex package（v0.3.0）于2019-09-03创建}

Answer 5

tidygraph可以在通过morph调用处于simplify_to的状态下简化图形，但是在unmorph插入时恢复为原始图形。

这是一个整洁的解决方法：

data <- read.table(header=TRUE, text="
from to weight
0 14 5 
0  1 1 
1  0 1
")

original <- as_tbl_graph(data)

输入：

> original
# A tbl_graph: 3 nodes and 3 edges
#
# A directed simple graph with 1 component
#
# Node Data: 3 x 1 (active)
  name 
  <chr>
1 0    
2 1    
3 14   
#
# Edge Data: 3 x 3
   from    to weight
  <int> <int>    <int>
1     1     3        5
2     1     2        1
3     2     1        1

解决方案：

modified <- original %>% activate(edges) %>% 
    # create a temporary grouping & filtering variable by sorting from/to IDs
    mutate(temp = ifelse(from > to, paste0(to, from), paste0(from, to))) %>% 
    group_by(temp) %>% 
    mutate(weight = sum(weight)) %>% 
    ungroup() %>% 
    dplyr::distinct(temp, .keep_all = TRUE) %>% 
    select(-temp)

输出：

> modified   
# A tbl_graph: 3 nodes and 2 edges
#
# A rooted tree
#
# Edge Data: 2 x 3 (active)
   from    to weight
  <int> <int>    <int>
1     1     3        5
2     1     2        2
#
# Node Data: 3 x 1
  name 
  <chr>
1 0    
2 1    
3 14