In[]:=
CompoundExpression[
]
​​deploy
Wed 27 Mar 2024 16:15:16
mathematica.SE question Visualizing diagrams needed to compute
Tr
3
A
3
(
T
A
)

​​parent: free-probability.nb​sibling: jamie-diagrams.nb​​(parent doc: Free Probability section)​​

Base code


Compare Domen/Roman side-by-side

In[]:=
ClearAll["Global`*"];​​getFormula[dd_]:=(​​d=dd;​​​​(*Checkwhethertwolistsareisomorphic*)​​SameStructureQ[a_,b_]:=Values[PositionIndex[a]]==Values[PositionIndex[b]];​​​​generatePaths[n_,d_]:=DeleteDuplicates[Prepend[1]/@Tuples[Range[n],{d}],SameStructureQ];​​makeEdges[lst_]:=DirectedEdge@@@Partition[lst,2,1];​​​​(*Generateallpossiblenon-isomorphicpathsoflengthdonn$vertices*);​​n$=d+1;​​paths=generatePaths[n$,d];​​​​(*Generateallpairsofpaths*)​​doublePaths=Tuples[paths,2];​​​​(*Selectonlythosethatendinthesamevertex*)​​doublePaths=Cases[doublePaths,{{__,lastVertex_},{__,lastVertex_}}];​​​​(*Makeedgesfromvertexpaths*)​​edges=Catenate/@Map[makeEdges,doublePaths,{2}];​​​​(*Selectonlythosepathsforwhichalledgesappearevenmanytimes*)​​edges=Select[edges,AllTrue[Values@Counts[#],EvenQ]&];​​​​(*CalculateE*)​​nk[n_,k_]:=n!/((n-k)!);​​​​(*CalculateE*)nk[n_,k_]:=n!/((n-k)!);​​​​FullSimplify[Total[nk[n,Max[Last/@#]]*Times@@((Values@Counts[#]-1)!!)&/@edges]]//Apart​​);​​Print["Domen"];​​Table[{i,getFormula[i]},{i,1,4}]//TableForm​​​​Print["Roman"];​​f[A_,q_]:=Tr[MatrixPower[A,q].MatrixPower[Transpose[A],q]];​​f[A_,q_]:=Length[A](#.#&[MatrixPower[A,q][[1]]]);​​F[n_Integer?Positive,q_Integer?Positive]:=F[n,q]=Expand[f[Array[a,{n,n}],q]]/.{a[__]^(m_?EvenQ)->(m-1)!!,a[__]->0};​​Table[{i,FindSequenceFunction[Table[F[n,i],{n,7}],n]},{i,{1,2,3,4}}]//TableForm
Domen
Out[]//TableForm=
1
2
n
2
2n+
3
n
3
4n+10
2
n
+
4
n
4
40n+40
2
n
+24
3
n
+
5
n
Roman
Out[]//TableForm=
1
2
n
2
2n+
3
n
3
4n+10
2
n
+
4
n
4
48n+28
2
n
+28
3
n
+
5
n