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

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

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

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

然而，对于大图，这效率不高。另外，我重复这个过程一遍。

• 低效率的第一层是边的随机选择 使用 <mat-form-field appearance="standard"> <mat-label>NIC Number</mat-label> <input matInput placeholder="Enter NIC no" formControlName="NIC"> <mat-error *ngIf="form.controls['NIC'].errors?.required; else minvalue">This field is mandatory. </mat-error> <ng-template #minvalue> <mat-error *ngIf="form.controls['NIC'].errors?.minlength; else maxvalue">Minimum 10 charactors needed. </mat-error> </ng-template> <ng-template #maxvalue> <mat-error *ngIf="form.controls['NIC'].errors?.maxLength; else numericonly">Maximum 10 charactors allowed. </mat-error> </ng-template> <ng-template #numericonly> <mat-error *ngIf="form.controls['NIC'].errors?.pattern"> Numeric characters only. </mat-error> </ng-template> </mat-form-field> 函数（占 25% 的时间）
• 低效率的第二层是向现有的空域添加边 使用 rbin() 函数绘制图形（占 75% 的时间）

对如何提高效率有什么建议吗？

这是我尝试过的：

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

add_edges()

2. 其次，我假设边以概率“prob.meet”弹出，并将它们添加到一个空图中。我这样做的原因是强制 library(igraph) nodes = 5 g1 <- barabasi.game(nodes) EL1 <- get.edgelist(g1,names=FALSE) 在大小上与 g_meet 一致。

g1

解决方法

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

It has been reported 表明在您的特定用例中使用 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)

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

所以我担心如果你使用 igraph，速度不会有太大的提升。

,

您可以像下面那样使用 delete_edges

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

哪里

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

基准测试

f_OP <- function() {
  EL1 <- get.edgelist(g1,names = FALSE)
  EL_meet <- matrix(EL1[(as.logical(rbinom(nrow(EL1),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,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