大图中的随机会议：在 R 中添加或删除图边的有效方法

Question

我正在尝试找到一种使用 igraph 在 R 中的图形中模拟随机会议的有效方法。

我设法使用下面的代码做到了这一点，其中我假设边以一定的概率出现 (prob.meet) 并将它们添加到相同大小的 (pre-existent) 空图中。

但是，对于大图，这效率不高。另外，我重复这个过程。

第一层低效率是边的随机选择使用 rbin() 函数（占 25% 的时间）
第二层效率低下是在现有的空白处添加边使用 add_edges() 函数的图表（占 75% 的时间）

有什么提高效率的建议吗？

这是我尝试过的：

首先，我创建一个随机图：

library(igraph)

nodes = 5
g1 <- barabasi.game(nodes)
EL1 <- get.edgelist(g1, names=FALSE)

其次，我假设边以“prob.meet”的概率弹出，并将它们添加到空图中。我这样做的原因是强制 g_meet 的大小与 g1.

prob.meet = 0.5

EL_meet <- matrix(EL1[(as.logical(rbinom(nrow(EL1), 1, prob.meet))),],
                  nrow=2,byrow = TRUE
                  )

g_meet <- make_empty_graph(n = nodes) %>%
            add_edges(EL_meet)

Answer 1

据我所知，只有边际速度提升。

在您的特定用例中使用 runif() 比使用 rbinom() 更快。运行它在我的系统上似乎证实了这一点：

prob.meet <- 0.5
system.time({rbinom(1000000, 1, prob.meet)})
#  user  system elapsed 
#  0.10    0.00    0.11
system.time({runif(1000000) < prob.meet})
#  user  system elapsed 
#  0.05    0.00    0.04

但是，如您所见，我们谈论的是进行一百万次随机抽取时仅提高了百分之几秒。

将边添加到新的空图形的替代方法是删除不相交的边。那看起来像这样：

library(igraph)

delete_non_meeting_edges <- function(g, prob.meet = 0.5) {
  g <- set_edge_attr(g, "meet", E(g), runif(gsize(g)) < prob.meet)
  delete_edges(g, E(g)[!meet])
}

## Usage
g <- barabasi.game(1000000)
delete_non_meeting_edges(g)

然而，上面的并不是真的更快。表明由于底层数据结构，igraph 对象的突变本质上很慢。在链接的答案中，矢量化被建议作为加速突变的一种方法，但是您作为上面的代码提供的示例都已经使用了它。

所以恐怕如果你用igraph的话，速度提升不了多少。

Answer 2

您可以像下面那样使用delete_edges

g1 %>%
  delete_edges(which(runif(ecount(.)) > prob.meet))

哪里

runif() > prob.meet 生成指示删除的随机逻辑数组。
ecount returns图中的边数g1.
which returns 应删除的边 ID。

基准测试

f_OP <- function() {
  EL1 <- get.edgelist(g1, names = FALSE)
  EL_meet <- matrix(EL1[(as.logical(rbinom(nrow(EL1), 1, prob.meet))), ],
    nrow = 2, byrow = TRUE
  )
  make_empty_graph(n = nodes) %>%
    add_edges(EL_meet)
}

f_Tim <- function() {
  delete_non_meeting_edges <- function(g, prob.meet) {
    g <- set_edge_attr(g, "meet", E(g), runif(gsize(g)) < prob.meet)
    delete_edges(g, E(g)[!meet])
  }
  delete_non_meeting_edges(g1, prob.meet)
}

f_TIC <- function() {
  g1 %>%
    delete_edges(which(runif(ecount(.)) > prob.meet))
}


nodes <- 100000
g1 <- barabasi.game(nodes)
prob.meet <- 0.5
microbenchmark(
  f_OP(),
  f_Tim(),
  f_TIC(),
  unit = "relative"
)

你会看到

Unit: relative
    expr      min       lq     mean   median       uq      max neval
  f_OP() 1.584501 1.583768 1.631061 1.618017 1.675887 1.535542   100
 f_Tim() 1.517888 1.520832 1.597230 1.584570 1.679498 1.585434   100
 f_TIC() 1.000000 1.000000 1.000000 1.000000 1.000000 1.000000   100

大图中的随机会议：在 R 中添加或删除图边的有效方法

Random meetings in large graphs: efficient way of adding or deleting edges of a graph in R

r

igraph

edges

基准测试