如果边缘属性大于某个值，则添加新顶点

Question

如果边属性大于某个值，我想插入一个新的顶点，然后分割边属性，例如：

library(igraph)
m <- matrix(c(1:5,2:6), nc = 2, byrow = F)
g <- graph_from_edgelist(m)
g <- set_edge_attr(g, name = "dists", value = c(5,8,10, 15, 7))
plot(g, edge.arrow.size = 0)

如果边属性“dists”> 10，我想添加一个新顶点，因为该图位于第 3 和第 4 个顶点之间，因为边属性为 15。

E(g)$dists
[1]  5  8 10 15  7

# psuedo code of what I want to do
for(i in E(g)) {
  if (E(g)$dists[i] > 10) {
    #add new node and split the edge weights
  }
}

结果会是什么样子

m2 <- matrix(c(1:6,2:7), nc = 2, byrow = F)
g2 <- graph_from_edgelist(m2)
g2 <- set_edge_attr(g2, name = "dists", value = c(10,10,10, 7.5, 7.5, 10))
plot(g2, edge.arrow.size = 0)

在旧的第 3 和第 4 个顶点之间添加了一个新顶点，并且边缘属性 15 已在新边上拆分为 7.5 和 7.5。

E(g2)$dists
[1] 10.0 10.0 10.0  7.5  7.5 10.0

这是一个玩具示例，在我的数据中有 100 个顶点，并且将添加 10 个新顶点，所以我不能手动完成。非常感谢任何帮助。

Answer 1

最好的方法是编写一个小函数来执行此操作，因为这需要几个不同的步骤来正确索引边缘和顶点。使用while 循环，该函数运行直到所有带有dists > 10 的边都被分割。

一、复制的数据：

library(igraph)

m <- matrix(c(1:5,2:6), nc = 2, byrow = F)
g <- graph_from_edgelist(m)
g <- set_edge_attr(g, name = "dists", value = c(5,8,10, 15, 7))

还有用cmets解释的函数：

split_edges <- function(g, thres, edge_name = "dists") {

  # Set the condition
  while (sum(edge_attr(g, edge_name) > thres) > 0) {

    # Get the edge id for first edge >= threshold
    eid <- which(E(g)$dists > thres)[1]

    # get vertex ids for that edge
    idx <- c(ends(g, eid))

    # Add the new vertex
    g <- add_vertices(g, 1)

    # get the id of the new vertex
    new_vx <- as_ids(V(g)[length(V(g))])

    # Add the edges
    g <- add_edges(g, c(new_vx, idx[1], new_vx, idx[2]))

    # Add the edge attributes
    g <- set_edge_attr(g, 
                       edge_name, 
                       index = E(g)[(length(E(g)) - 1):length(E(g))],
                       value = c(edge_attr(g, edge_name, index = eid) / 2,
                                 edge_attr(g, edge_name, index = eid) / 2))

    # delete the original edge 
    g <- delete_edges(g, eid)
  }

  return(g)

}

测试一下：

g2 <- split_edges(g, 10, "dists")
E(g2)$dists
#> [1]  5.0  8.0 10.0  7.0  7.5  7.5
plot(g2, edge.arrow.size = 0, edge.label = E(g2)$dists)

我也在一个更大的图表上快速测试了这一点：

set.seed(1981)
g <- sample_gnp(100, 0.1)
E(g)$dists <- floor(runif(length(E(g)), min = 0, max = 15)) 
sum(E(g)$dists > 10)
#> [1] 132

g2 <- split_edges(g, 10, "dists")
sum(E(g2)$dists > 10)
#> [1] 0
vcount(g2)
#> [1] 232

^{由reprex package (v0.3.0) 于 2020 年 4 月 29 日创建}