我正在igraph R中使用一个相当大的图形（~500万个顶点，4000万个边）。
我想为每个顶点创建一个新属性，这是每个连接的属性的平均值。
例如：
人员 A 的 X 值为 10，他们连接到人员 B、C 和 D，他们的 x 值分别为 20、50 和 65。我想为人员 A 分配一个新值 45（平均值为 20、50 和 65）。
我目前正在使用以下方法（来自另一个堆栈溢出答案）（我正在使用 10 个内核）
adjcency_list <- get.adjlist(g)
avg_contact_val <- ldply(adjcency_list, function(neis){ mean(V(g)[neis]$X, na.rm = T)},
.parallel = TRUE
)
V(g)$avg_contact_val <- avg_contact_val
这完全按照我的需要工作，但它不能很好地扩展，并且需要（非常！）很长时间才能在整个图形上完成。
- 有没有更有效的方法呢？
- 这是否属于使用 x 值而不是度的页面排名类型算法
- 是否可以以某种方式使用 GPU？
- 这在igraph Python中会更快吗？
编辑：
下面是一些示例数据以及对建议的方法的尝试：
set.seed(12345)
g <- erdos.renyi.game(10000, .0005)
V(g)$NAME <- c(1:10000)
V(g)$X <- round(runif(10000,0,30))
adjcency_list <- get.adjlist(g)
sub_ages <- data.frame(NAME = V(g)$NAME, X = V(g)$X)
dta.table <- data.table(sub_ages, key = "NAME")
数据表方法
system.time(
avg_contact_ages <- ldply(adjcency_list,
function(neis){
mean(dta.table[neis,mean(X)], na.rm = T)
}, .progress = "tk"
)
)
user system elapsed
38.87 1.50 40.37
数据框方法
sub_ages2 <- data.frame(row.names = V(g)$NAME, X = V(g)$X)
system.time(
avg_contact_ages <- ldply(adjcency_list,
function(neis){
mean(sub_ages2[neis, "X"], na.rm = T)
}, .progress = "tk"
)
)
user system elapsed
8.69 1.28 9.99
独创方法
system.time(
avg_contact_ages <- ldply(adjcency_list,
function(neis){
mean(V(g)[neis]$X, na.rm = T)
} , .progress = "tk"
)
)
user system elapsed
16.74 2.35 19.14
影子的方法
system.time(
avg_nei <- ldply(V(g), function(vert){
mean(get.vertex.attribute(g, "X", index=neighbors(g,vert)), na.rm=TRUE)
}, .progress = "tk")
)
user system elapsed
8.80 1.42 10.23
- 有没有更有效的方法呢？
我认为如此。不要一直调用V(g)，而是将属性放在向量中，并为其编制索引。如果包含一些示例数据，则还将包含一些代码。
- 这是否属于使用 x 值而不是度的页面排名类型算法
不，PageRank是递归的，你的排名取决于整个网络，而不仅仅是邻居的分数。
- 是否可以以某种方式使用 GPU？
不是与igraph。如果没有 GPU，您当然可以足够快地做到这一点，所以我不会那样做。
- 这在igraph Python中会更快吗？
取决于你怎么写。如果你用R写正确的方式，那么它在Python中也不会更快，imo。
编辑：
我省略了进度条，因为实际上这是最慢的。
上面最快的数据框解决方案
system.time({
sub_ages2 <- data.frame(row.names = V(g)$NAME, X = V(g)$X);
avg_contact_ages <- ldply(adjcency_list, function(neis) {
mean(sub_ages2[neis, "X"], na.rm = T)
})
})
# user system elapsed
# 0.368 0.020 0.386
sapply速度稍快
system.time({
sub_ages2 <- data.frame(row.names = V(g)$NAME, X = V(g)$X);
avg_contact_ages <- sapply(adjcency_list, function(neis) {
mean(sub_ages2[neis, "X"], na.rm = TRUE)
})
})
# user system elapsed
# 0.340 0.017 0.356
使用因子
system.time({
adj_vec <- unlist(adjcency_list)
adj_fac <- factor(rep(seq_along(adjcency_list),
sapply(adjcency_list, length)),levels=seq_len(vcount(g)))
avg_contact_ages <- tapply(V(g)$X[adj_vec], adj_fac, mean, na.rm=TRUE)
})
# user system elapsed
# 0.131 0.008 0.138
如果你需要更多的加速，你可能需要去C/C++，Rcpp将是一个相对简单的解决方案。
函数get.vertex.attribute增加了一些速度。但是对于图表的大小，这可能还不够。无论如何，这是我稍微快一点的版本（在我的基准测试中，它比你的版本快2.5倍）：
avg_nei <- ldply(V(g), function(vert){
mean(get.vertex.attribute(g, "X", index=neighbors(g,vert)), na.rm=TRUE)
}, .parallel = TRUE)
V(g)$avg_contact_val <- avg_nei