Efficient way of calculating average value of connections in igraph? - r

Question

I'm working with a fairly large graph in igraph R. (~5 million vertices, 40 million edges).
I want to create a new attribute for each vertex which is the average value of an attribute of each of their connections.
For example:
Person A has an X value of 10, they're connected to persons B, C and D who have x values of 20, 50 and 65 respectively. I want to assign a new value of 45 to Person A (average of 20, 50 and 65).
I'm currently using the following method (from another stackoverflow answer) (I'm using 10 cores)
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
This works exactly as I need it to, but it doesn't scale very well and would take a (very!) long time to do on the full graph.
Is there a more efficient method of doing this?
Could this fall under a page rank type algorithm using the x value instead of degree
Would it be possible to use a GPU somehow?
Would this be quicker in igraph Python?
EDIT:
Here's some sample data and an attempt at the approaches suggested:
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")
DATA TABLE APPROACH
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
DATA FRAME APPROACH
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
ORIGINAL APPROACH
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
Shadow's approach
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

Answer 1

Is there a more efficient method of doing this?
I think so. Do not call V(g) all the time, but put the attribute in a vector, and index it. If you include some example data, then I'll also include some code.
Could this fall under a page rank type algorithm using the x value instead of degree
No, PageRank is recursive, your rank depends on the whole network, not only on the score of your neighbors.
Would it be possible to use a GPU somehow?
Not with igraph. Put you can certainly make this fast enough without the GPU, so I would not go that way.
Would this be quicker in igraph Python?
Depends how you write it. If you write it the correct way in R, then it will not be faster in Python, either, imo.
EDIT:
I left out the progress bar, because that's the slowest, actually.
Fastest solution above with data frame
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
Slightly faster with 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
Using factors
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
If you need more speedup, you'll probably need to go to C/C++, Rcpp would be a relatively easy solution.

Answer 2

The function get.vertex.attribute adds some speed. But for the size of your graph, that probably won't be enough. Anyway, here's my slightly faster version (in my benchmark tests for much smaller graphs, it's about 2.5 times faster than your version):
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