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

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的edge属性在新边之间拆分为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))

以及带有注释说明的功能：

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-04-29创建}