0

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 

2 Answers 2

2
  • 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.

2
  • I've added in some sample data and some tests. Is the data.frame approach what you were suggesting? Could you offer any improvements?
    – Ger
    Apr 3, 2014 at 15:03
  • @Ger: thanks, will look at it later today, need to run now. Btw. please set the random seed in your example code, for reproducibility. Thanks Apr 3, 2014 at 15:53
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
1
  • Thanks shadow, certainly faster... see speed test above
    – Ger
    Apr 3, 2014 at 15:04

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.