TunkRank in Mathematica

Question

I'm trying out Mathematica for the first time and using TunkRank as my algorithm of choice. Here is what I came up with:

Following = {{2, 3, 4}, {0, 4}, {1, 3}, {1, 4}, {0, 2}}
Followers = {{1, 4}, {2, 3}, {0, 4}, {0, 2}, {0, 1, 3}}
p = 0.05
Influence[x_] := Influence[x] =
    Sum[1 + (p * Influence[Followers[[x, i]]])/(1 + 
        Length[Following[[x]]]), {i, 0, Length[Followers[[x]]]}]

If you run this in Mathematica you will see that it doesn't operate on just the follower nodes . Instead, the recursion is infinite. What am I doing wrong?

Answer 1

Here is a variant for the iterations shown in a comment. It uses generation indexing so as to allow memoization.

In[104]:= Do[influence[0][j] = 1, {j, 5}];

influence[j_][x_] := 
 influence[j][x] = 
  Sum[(1 + p*influence[j - 1][followers[[x, i]]])/(1 + 
      Length[following[[followers[[x, i]]]]]), {i, 
    Length[followers[[x]]]}];

In[105]:= Do[Print[influence[j] /@ {1, 2, 3, 4, 5}];, {j, 10}];

During evaluation of In[105]:= {1.,1.,0.875,0.875,1.375}

During evaluation of In[105]:= {1.0625,0.9583333333333333,0.9375,0.8541666666666666,1.354166666666667}

During evaluation of In[105]:= {1.052083333333333,0.9652777777777777,0.9418402777777777,0.8723958333333333,1.3515625}

During evaluation of In[105]:= {1.052806712962963,0.9690393518518517,0.9401041666666666,0.8718171296296295,1.354456018518518}

During evaluation of In[105]:= {1.053915895061728,0.968653549382716,0.94067684220679,0.8716182002314814,1.355076919367284}

During evaluation of In[105]:= {1.053955078125,0.9687158404063785,0.94091897344393,0.871852293917181,1.355118111818416}

During evaluation of In[105]:= {1.053972325370799,0.9687952112268517,0.9409307367353609,0.87189754700628,1.355172407152885}

During evaluation of In[105]:= {1.053994603063289,0.9688047139569401,0.9409419418634972,0.8719016634605767,1.355195333710205}

During evaluation of In[105]:= {1.054000007944524,0.9688072675540123,0.9409485476679453,0.871906315693494,1.355200388285831}

During evaluation of In[105]:= {1.054001275973307,0.9688091438935732,0.9409500657073706,0.8719080922710565,1.35520226486765}

I think it is better to just set up and solve a linear system. Can be done as below.

In[107]:= NSolve[
 Table[inf[x] == 
   Sum[(1 + p*inf[followers[[x, i]]])/(1 + 
       Length[following[[followers[[x, i]]]]]), {i, 
     Length[followers[[x]]]}], {x, 5}], inf /@ Range[5]]

Out[107]= {{inf[1] -> 1.054002220652064, inf[2] -> 0.9688099323710506,
   inf[3] -> 0.940950842838397, inf[4] -> 0.8719087513879075, 
  inf[5] -> 1.355203391541334}}

This is related to the iterative approach above insofar as that isone method of solving such a linear system (it is the Jacobi method).

Answer 2

For a start, you might want to consider making p a parameter with a default value (see documentation). Something like Influence[x_,p_?Positive:0.05]:= (* definition *).

Second, you are setting the part specification i to start at 0. In Mathematica, indices start at 1, not 0. You will end up getting the Head of the object. In this case, Followers[[x,0]] will return List. You need to change this and increment your data by 1.

Following = {{3, 4, 5}, {1, 5}, {2, 4}, {2, 5}, {1, 3}};
Followers = {{2, 5}, {3, 4}, {1, 5}, {1, 3}, {1, 2, 4}};
Influence[x_, P_: 0.05] := 
 Influence[x] = 
  Sum[1 + (P*Influence[Followers[[x, i]]])/(1 + 
      Length[Following[[x]]]), {i, Length[Followers[[x]]]}]

Third, you have some recursiveness in your data. Person 1 is followed by person 2, who is followed by 3 and 4, who are both followed by 1. So of course it is recursive.

follows = Join @@ Thread /@ Thread[Following -> Range@5]
 {3 -> 1, 4 -> 1, 5 -> 1, 1 -> 2, 5 -> 2, 2 -> 3, 4 -> 3, 2 -> 4, 
 5 -> 4, 1 -> 5, 3 -> 5}

GraphPlot[follows, DirectedEdges -> True, VertexLabeling -> True]

You could consider an explicit FixedPoint type of iteration, using Chop or the SameTest option to prevent recursion for ever with small changes. But I doubt even that will avoid the problem with a test data set as cyclical as yours.

EDIT

ok so I worked out the iterative solution. First you need to convert your followers data into an adjacency matrix.

(* Following = {{3, 4, 5}, {1, 5}, {2, 4}, {2, 5}, {1, 3}}; *)
Followers = {{2, 5}, {3, 4}, {1, 5}, {1, 3}, {1, 2, 4}};

adjmatrix = PadRight[SparseArray[List /@ # -> 1] & /@ Followers]

{{0, 1, 0, 0, 1},
 {0, 0, 1, 1, 0},
 {1, 0, 0, 0, 1},
 {1, 0, 1, 0, 0},
 {1, 1, 0, 1, 0}}

This gives the bit equivalent to the Length statements in your version.

vec1 = Table[1, {5}]  (* {1, 1, 1, 1, 1} *)

adjmatrix.vec1

vec1.adjmatrix

{2, 2, 2, 2, 3}

{3, 2, 2, 2, 2}

Convergence is fast.

 NestList[1 + 0.02 * adjmatrix.#1/(1 + vec1.adjmatrix) &, {1, 1, 1, 1, 1}, 5]
{{1, 1, 1, 1, 1}, {1.01, 1.01333, 1.01333, 1.01333, 1.02}, {1.01017, 
 1.01351, 1.01353, 1.01349, 1.02024}, {1.01017, 1.01351, 1.01354, 
 1.01349, 1.02025}, {1.01017, 1.01351, 1.01354, 1.01349, 
 1.02025}, {1.01017, 1.01351, 1.01354, 1.01349, 1.02025}}

Given the adjacency matrix, you can have a function:

TunkRank[mat_?MatrixQ, p_?Positive] :=
 With[{vec = Table[1, {Length[mat]}]},
 FixedPoint[1 + p * mat.#1/(1 + vec.mat) &, vec]]

Hope that helps. I assume this is giving the right answers.

Answer 3

The first problem I see is that the input to your function is 0. Consider the term Followers[[x, i]] in your definition of Influence. Recall that Part 0 of an expression gives you its Head.

So Following[[0]] (when x=0) will give you List and Followers[[0,0]] (which is the case when x=0 and i=0) will give you Symbol, which is the Head of List. I don't think that is what you want.

Secondly, in such recursive definitions, usually there are one or two seed values/starter values/initial values whatever you call them. For example, the Fibonacci equation in recursive form is

f[0]=1;
f[1]=1;
f[n_]:=f[n]=f[n-1]+f[n-2]

where you've defined f for the first two cases 0 and 1. However, in your function, there is no such initialization and there is the likelihood that it just runs in circles.

There's not much more I can say without knowing what the TunkRank algorithm is.

Answer 4

Quoting from the TunkRank post that I wrote and someone else cited:

The recursion is infinite over a graph with directed cycles, but rapidly converges as high powers of p approach zero. I would think this measure wouldn’t be hard to compute to a reasonable accuracy.

Even if there are no directed cycles, you might as well stop the computation when the numbers get small enough.

Good luck with TunkRank, and feel free to reach out to me at [email protected] if you have any questions about it!