Mathematica中的TunkRank

Question

我第一次尝试使用Mathematica并使用TunkRank作为我的首选算法.这是我想出的:

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

如果您在Mathematica中运行它,您将看到它不仅仅在跟随节点上运行.相反,递归是无限的.我究竟做错了什么？

Answer 1

以下是注释中显示的迭代的变体.它使用生成索引以便进行记忆.

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}

我认为建立和解决线性系统会更好.可以如下完成.

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}}

这与上述迭代方法有关,因为这是解决这种线性系统的一种方法(它是雅可比方法).

Answer 2

首先,您可能需要考虑p使用默认值创建参数(请参阅文档).有点像Influence[x_,p_?Positive:0.05]:= (* definition *).

其次,您将零件规格设置i为从0开始.在Mathematica中,索引从1开始,而不是0.您将最终得到Head对象的内容.在这种情况下,Followers[[x,0]]将返回List.您需要更改此值并将数据增加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]]]}]

第三,你的数据有一些递归性.第1个人跟随人2,其后是3和4,后面跟着1.所以当然它是递归的.

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]

您可以考虑一种显FixedPoint式迭代类型,使用Chop或SameTest选项来防止递归,只需进行少量更改.但我怀疑即使这样也可以避免测试数据集与您的周期性问题一样.

编辑

好的,所以我找出了迭代解决方案.首先,您需要将关注者数据转换为邻接矩阵.

(* 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}}

这给出了Length与您的版本中的语句等效的位.

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

adjmatrix.vec1

vec1.adjmatrix

{2, 2, 2, 2, 3}

{3, 2, 2, 2, 2}

融合很快.

 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}}

给定邻接矩阵,您可以拥有一个函数:

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

希望有所帮助.我认为这给出了正确的答案.