6
$\begingroup$

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}]
Improve this question
$\endgroup$
3
  • 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$
    – Daniel Lichtblau
    Commented Jun 22, 2015 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$
    – David G. Stork
    Commented Jun 22, 2015 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
    Commented Jun 23, 2015 at 2:50

1 Answer 1

Reset to default
8
$\begingroup$

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}];
   While[
    r1 > acc[[i]] || r2 > acc[[i]],
    If[r1 > acc[[i]], i1 = i];
    If[r2 > acc[[i]], i2 = i];
    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.

Improve this answer
$\endgroup$
1
  • $\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
    Commented Jun 23, 2015 at 2:36

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.