迭代顶点并根据邻居的属性计算新属性的快速方法

R. *_*Zhu 5 r igraph sna

我正在做一个简单的任务:迭代所有顶点并根据其邻居的属性计算新属性。我搜索了 SO,到目前为止我知道至少有三种方法可以做到这一点:

  1. 使用 ad_adj_list 创建一个 adj 列表,然后迭代每个元素;
  2. 使用 sapply 直接迭代每个顶点。

然而,对于我的数据量(30 万个顶点和 800 万条边)来说,这两种方法都花费太长的时间。有没有快速循环顶点的方法?谢谢!

对于基准测试,假设我有以下示例数据:

set.seed <- 42
g <- sample_gnp(10000, 0.1)
V(g)$name <- seq_len(gorder(g)) # add a name attribute for data.table merge
V(g)$attr <- rnorm(gorder(g))
V(g)$mean <- 0 # "mean" is the attribute I want to compute
Run Code Online (Sandbox Code Playgroud)

方法1的代码是:

al <- as_adj_list(g)
attr <- V(g)$attr
V(g)$mean <- sapply(al, function(x) mean(attr[x])) 
# took 28s
# most of the time is spent on creating the adj list
Run Code Online (Sandbox Code Playgroud)

方法2的代码是:

compute_mean <- function(v){
    mean(neighbors(g, v)$attr)
}
V(g)$mean <- sapply(V(g), compute_mean)  # took 33s
Run Code Online (Sandbox Code Playgroud)

我相信 igraph-R 在顶点交互方面不应该这么慢,否则,这将使分析数百万级的大图变得不可能,我认为这个任务对于 R 用户来说应该是很常见的!

更新

根据@MichaelChirico的评论,现在我想出了第三种方法:将图结构导入到data.table中,并使用data.tableby语法进行计算,如下:

gdt.v <- as_data_frame(g, what = "vertices") %>% setDT() # output the vertices
gdt.e <- as_data_frame(g, what = "edges") %>% setDT() # output the edges
gdt <- gdt.e[gdt.v, on = c(to = "name"), nomatch = 0] # merge vertices and edges data.table
mean <- gdt[, .(mean = mean(attr)), keyby = from][, mean]
V(g)$mean <- mean 
# took only 0.74s !!
Run Code Online (Sandbox Code Playgroud)

data.table 方式要快得多。然而,其结果与前两种方法并不完全相同。此外,我很失望地看到我必须依赖另一个包来完成如此简单的任务,我认为这应该是 igraph-R 的强项。希望我错了!

Mic*_*hał 2

我不确定实际问题出在哪里...当我重新运行您的代码时:

library(microbenchmark)
library(data.table)
library(igraph)
set.seed <- 42
g <- sample_gnp(10000, 0.1)
V(g)$name <- seq_len(gorder(g)) # add a name attribute for data.table merge
V(g)$attr <- rnorm(gorder(g))
V(g)$mean <- 0 # "mean" is the attribute I want to compute
gg <- g
Run Code Online (Sandbox Code Playgroud)

...并比较表达式中的两种方法e1e2

e1 <- expression({
  al <- as_adj_list(gg)
  attr <- V(gg)$attr
  V(gg)$mean <- sapply(al, function(x) mean(attr[x]))  
})

e2 <- expression({
  gdt.v <- as_data_frame(g, what = "vertices") %>% setDT() # output the vertices
  gdt.e <- as_data_frame(g, what = "edges") %>% setDT() # output the edges
  gdt <- gdt.e[gdt.v, on = c(to = "name"), nomatch = 0] # merge vertices and edges data.table
  mean <- gdt[, .(mean = mean(attr)), keyby = from][, mean]
  V(g)$mean <- mean 
})
Run Code Online (Sandbox Code Playgroud)

时间安排是:

microbenchmark(e1, e2)

## Unit: nanoseconds
##  expr min lq  mean median uq max neval cld
##    e1  47 47 51.42     48 48 338   100   a
##    e2  47 47 59.98     48 48 956   100   a
Run Code Online (Sandbox Code Playgroud)

非常相似,结果

all.equal(V(g)$mean, V(gg)$mean)

## [1] TRUE
Run Code Online (Sandbox Code Playgroud)

... 是相同的。