Search code examples
functionmathrecursionwolfram-mathematicaranking

TunkRank in Mathematica

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?

Solution

  • 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]

    enter image description here

    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.