I was wondering if anyone could help me to speed up this code snippet which creates simple (sparse) networks by preferential attachment.

The algorithm adds a vertex and an edge each time interval. Each end of the edge is assigned independantly according to a lottery where vertices have weight $m+k$ where $m$ is constant and $k$ is the vertex degree.

The issue is that while RandomChoice performs the lottery mechanism very elegantly and very quickly for $n<10^6$, it does so very slowly for large networks.

n = 10^6;
w = Array[0 &, n];
x = Range[n];
m = 1;
g = Table[
  {i, j} = RandomChoice[w[[1 ;; t]] + m -> x[[1 ;; t]], 2];
  w[[{i, j}]]++;
  i <-> j,
{t, 1, n}]
  • 2
    $\begingroup$ You are recreating a sublist at every iteration and that means it will be, at best, O(n^2) complexity. Most likely better would be to pick two random integers between 1 and t and use them as indices. $\endgroup$ Jun 22 '15 at 22:44
  • $\begingroup$ Can you explain precisely the properties you want for your graph? I strongly suspect there are far faster---${\cal O}(n)$---algorithms for what you seek. $\endgroup$ Jun 22 '15 at 23:10
  • $\begingroup$ The properties are actually quite easily derived in the limit. In this instance I just want to see the significance of finite-size effects. $\endgroup$
    – Crêpo
    Jun 23 '15 at 2:50

Preferential growth with an increasing number of vertices means that older vertices will have far more connections than the newer ones. So we know which vertices will probably be chosen, and we should try to use that in our algorithm. One way to do it is roulette wheel selection:

randomChoice = Compile[{{list, _Real, 1}}, 
  Module[{acc, i = 1, r1 = 0., r2 = 0., i1 = 1, i2 = 1, res},
   acc = Accumulate[list];
   r1 = RandomReal[{1, Last@acc}];
   r2 = RandomReal[{1, Last@acc}];
    r1 > acc[[i]] || r2 > acc[[i]],
    If[r1 > acc[[i]], i1 = i];
    If[r2 > acc[[i]], i2 = i];
   {i1, i2}
   ], CompilationTarget -> "C", RuntimeOptions -> {"Speed"}]

The surrounding code can be left mostly untouched:

m = 1;
w = ConstantArray[0, n] + m;
Table[{i, j} = randomChoice@Take[w, t];
 w[[{i, j}]]++; i <-> j, {t, 2, n}]

In the following graph the blue line is the simulation using RandomChoice and the orange line is the simulation using randomChoice. Because of the thing that I mentioned I believe that the difference is only going to grow as n grows. The data points are for n = {10^3, 5 10^3, 10^4, 5 10^4, 10^5}, the y axis is given in seconds.

Mathematica graphics

A further optimization might be to not use Accumulate which will sum over all elements. Instead the total sum of vertex degrees can be calculated as t (m + 2) and the accumulated value can be calculated in the While loop.

  • $\begingroup$ Thank you. I didn't think to look into how RandomChoice works and you're right, that is a much better way to go about it. $\endgroup$
    – Crêpo
    Jun 23 '15 at 2:36

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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