改进R中用于社交网络分析的处理性能

Question

I am doing social network analysis using igraph package in R and I am dealing with close to 2 million vertices and edges. Also calculating degrees of separations which are nearly 8 million vertices and edges. Usually, it takes somewhere between 2 to 3 hours for execution which is way too much high. I need some input and suggestions to improve this performance. Below is the sample code I am using:

g <- graph.data.frame( ids, directed = F) # ids contains approximately 2 million records
distances(graph = g, v = t_ids$ID_from[x], to = t_ids$ID_to[x], weights = NA)
# t_ids contains approximately 8 million records for which degrees of separation is to be calculated using Shortest Path Algorithms

Thanking in advance!

Answer 1

I don't think so, but I'd be very happy to be proven wrong.

You should look into other ways of optimising the code that is running.

If your data is fixed, you could compute the distances once, save the (probably rather big) distance matrix, and ask that for degrees of separation.

If your analysis does not require distances between all x vertices, you should look into making optimisations in your code by shortening t_ids$ID_from[x] . Get only the distances you need. I suspect that you're already doing this, though.

distances() actually computes rather quickly. At 10'000 nodes (which amounts to 4,99*10^6 undirected distances), my crappy machine gets a full 700MB large distance-matrix in a few seconds.

I first thought about the different algorithms you can choose in distances() , but now I doubt that they will help you. I ran a speed-test on the different algorithms to see if I could recommend any of them to you, but they all seem to run at more or less the same speed (results are relations to time to compute using automatic algorithm that would be used in your code above):

  sample automatic unweighted  dijkstra bellman-ford   johnson
1     10         1  0.9416667 0.9750000    1.0750000 1.0833333
2    100         1  0.9427083 0.9062500    0.8906250 0.8958333
3   1000         1  0.9965636 0.9656357    0.9977090 0.9873998
4   5000         1  0.9674200 0.9947269    0.9691149 1.0007533
5  10000         1  1.0070885 0.9938136    0.9974223 0.9953602

I don't think anything can be concluded from this, but it's running on an Erdős-Rényi model. It's possible that your network structure favours one algorithm over another, but they would still not give you anywhere near the performance boost that you're hoping for.

The code is here:

# igrpah
library(igraph)

# setup:
samplesizes <- c(10, 100, 1000, 5000, 10000)
reps <- c(100, 100, 15, 3, 1)
algorithms = c("automatic", "unweighted", "dijkstra", "bellman-ford", "johnson")
df <- as.data.frame(matrix(ncol=length(algorithms), nrow=0), stringsAsFactors = FALSE)
names(df) <- algorithms

# any random graph
g <- erdos.renyi.game(10000, 10000, "gnm")

# These are the different algorithms used by distances:
m.auto <- distances(g, v=V(g), to=V(g), weights=NA, algorithm="automatic")
m.unwg <- distances(g, v=V(g), to=V(g), weights=NA, algorithm="unweighted")
m.dijk <- distances(g, v=V(g), to=V(g), weights=NA, algorithm="dijkstra")
m.belm <- distances(g, v=V(g), to=V(g), weights=NA, algorithm="bellman-ford")
m.john <- distances(g, v=V(g), to=V(g), weights=NA, algorithm="johnson")

# They produce the same result:
sum(m.auto == m.unwg & m.auto == m.dijk & m.auto == m.belm & m.auto == m.john) == length(m.auto)


# Use this function will be used to test the speed of distances() run using different algorithms
test_distances <- function(alg){
       m.auto <- distances(g, v=V(g), to=V(g), weights=NA, algorithm=alg)
       (TRUE)
}

# Build testresults
for(i.sample in 1:length(samplesizes)){
       # Create a random network to test
       g <- erdos.renyi.game(samplesizes[i.sample], (samplesizes[i.sample]*1.5), type = "gnm", directed = FALSE, loops = FALSE)

       i.rep <- reps[i.sample]

       for(i.alg in 1:length(algorithms)){
              df[i.sample,i.alg] <- system.time( replicate(i.rep, test_distances(algorithms[i.alg]) ) )[['elapsed']]
       }
}

# Normalize benchmark results
dfn <- df

dfn[,1:length(df[,])] <- df[,1:length(df[,])] / df[,1]
dfn$sample <- samplesizes
dfn <- dfn[,c(6,1:5)]
dfn