(* ::Package:: *)

(************************************************************************)
(* This file was generated automatically by the Mathematica front end.  *)
(* It contains Initialization cells from a Notebook file, which         *)
(* typically will have the same name as this file except ending in      *)
(* ".nb" instead of ".m".                                               *)
(*                                                                      *)
(* This file is intended to be loaded into the Mathematica kernel using *)
(* the package loading commands Get or Needs.  Doing so is equivalent   *)
(* to using the Evaluate Initialization Cells menu command in the front *)
(* end.                                                                 *)
(*                                                                      *)
(* DO NOT EDIT THIS FILE.  This entire file is regenerated              *)
(* automatically each time the parent Notebook file is saved in the     *)
(* Mathematica front end.  Any changes you make to this file will be    *)
(* overwritten.                                                         *)
(************************************************************************)



(* ::Input::Initialization:: *)
SetDirectory["C:\\drorbn\\AcademicPensieve\\Projects\\HigherRank\\Rolands_A2"];
Once[<<KnotTheory`];
 <<../Rot.m
SuperPlus[(SuperPlus[\[Alpha]_])]:=\!\(\*SuperscriptBox[\(\[Alpha]\), \("\<++\>"\)]\);    
(* this is for cosmetic reasons only *)


(* ::Input::Initialization:: *)
Subscript[r, 0][1,i_,j_]:=Subscript[p, 3,j] Subscript[x, 1,i] Subscript[x, 2,i]-(Subscript[p, 3,j] Subscript[x, 1,j] Subscript[x, 2,i])/Subscript[T, 1](*from r0p*)
Subscript[r, 0][-1,i_,j_]:=-((Subscript[p, 3,j] Subscript[x, 1,i] Subscript[x, 2,i])/(\!\(
\*SubsuperscriptBox[\(T\), \(1\), \(2\)]\ 
\*SubscriptBox[\(T\), \(2\)]\)))+(Subscript[p, 3,j] Subscript[x, 1,j] Subscript[x, 2,i])/(Subscript[T, 1] Subscript[T, 2])
Subscript[r, 1][1,i_,j_]:=(Subscript[T, 2] Subscript[p, 1,j] Subscript[p, 2,j] Subscript[x, 1,i] Subscript[x, 2,i])/(-1+Subscript[T, 1] Subscript[T, 2])-(Subscript[p, 1,j] Subscript[p, 2,i] Subscript[x, 1,j] Subscript[x, 2,i])/((-1+Subscript[T, 1]) Subscript[T, 1] (-1+Subscript[T, 1] Subscript[T, 2]))-(Subscript[p, 1,j] Subscript[p, 2,j] Subscript[x, 1,j] Subscript[x, 2,i])/((-1+Subscript[T, 1]) Subscript[T, 1])+(Subscript[p, 1,i] Subscript[p, 2,j] Subscript[x, 1,i] Subscript[x, 2,j])/((-1+Subscript[T, 1]) (-1+Subscript[T, 1] Subscript[T, 2]))+Subscript[p, 1,j] Subscript[p, 2,i] Subscript[x, 3,i]-Subscript[p, 1,j] Subscript[p, 2,j] Subscript[x, 3,i]+(Subscript[p, 3,j] Subscript[x, 3,i])/(Subscript[T, 1] (-1+Subscript[T, 1] Subscript[T, 2]))-Subscript[p, 1,j] Subscript[p, 3,j] Subscript[x, 1,i] Subscript[x, 3,i]+(Subscript[p, 1,j] Subscript[p, 3,i] Subscript[x, 1,j] Subscript[x, 3,i])/((-1+Subscript[T, 1]) Subscript[T, 1] (-1+Subscript[T, 1] Subscript[T, 2]))+(Subscript[p, 1,j] Subscript[p, 3,j] Subscript[x, 1,j] Subscript[x, 3,i])/(-1+Subscript[T, 1])-(Subscript[T, 2] Subscript[p, 2,j] Subscript[p, 3,j] Subscript[x, 2,i] Subscript[x, 3,i])/Subscript[T, 1]-(Subscript[p, 2,j] Subscript[p, 3,i] Subscript[x, 2,j] Subscript[x, 3,i])/(Subscript[T, 1] (-1+Subscript[T, 1] Subscript[T, 2]))-(Subscript[p, 1,i] Subscript[p, 3,j] Subscript[x, 1,i] Subscript[x, 3,j])/((-1+Subscript[T, 1]) (-1+Subscript[T, 1] Subscript[T, 2]))+(Subscript[T, 2] Subscript[p, 2,j] Subscript[p, 3,j] Subscript[x, 2,i] Subscript[x, 3,j])/(Subscript[T, 1] (-1+Subscript[T, 1] Subscript[T, 2]))

Subscript[r, 1][-1,i_,j_]:=
(Subscript[p, 1,j] Subscript[p, 2,i] Subscript[x, 1,i] Subscript[x, 2,i])/(\!\(
\*SubsuperscriptBox[\(T\), \(1\), \(2\)]\ \((\(-1\) + 
\*SubscriptBox[\(T\), \(1\)]\ 
\*SubscriptBox[\(T\), \(2\)])\)\))-((-1+Subscript[T, 2]) Subscript[p, 1,i] Subscript[p, 2,j] Subscript[x, 1,i] Subscript[x, 2,i])/((-1+Subscript[T, 1]) Subscript[T, 2] (-1+Subscript[T, 1] Subscript[T, 2]))+((-Subscript[T, 1]-Subscript[T, 2]+Subscript[T, 1] Subscript[T, 2]) Subscript[p, 1,j] Subscript[p, 2,j] Subscript[x, 1,i] Subscript[x, 2,i])/(\!\(
\*SubsuperscriptBox[\(T\), \(1\), \(2\)]\ 
\*SubscriptBox[\(T\), \(2\)]\ \((\(-1\) + 
\*SubscriptBox[\(T\), \(1\)]\ 
\*SubscriptBox[\(T\), \(2\)])\)\))+(Subscript[p, 1,j] Subscript[p, 2,i] Subscript[x, 1,j] Subscript[x, 2,i])/((-1+Subscript[T, 1]) Subscript[T, 1] (-1+Subscript[T, 1] Subscript[T, 2]))+(Subscript[p, 1,j] Subscript[p, 2,j] Subscript[x, 1,j] Subscript[x, 2,i])/(Subscript[T, 1] (-1+Subscript[T, 1] Subscript[T, 2]))-(Subscript[p, 1,i] Subscript[p, 2,j] Subscript[x, 1,i] Subscript[x, 2,j])/((-1+Subscript[T, 1]) (-1+Subscript[T, 1] Subscript[T, 2]))+(Subscript[p, 1,j] Subscript[p, 2,j] Subscript[x, 1,i] Subscript[x, 2,j])/(Subscript[T, 1] (-1+Subscript[T, 1] Subscript[T, 2]))-(Subscript[p, 1,j] Subscript[p, 2,i] Subscript[x, 3,i])/Subscript[T, 1]+(Subscript[p, 1,j] Subscript[p, 2,j] Subscript[x, 3,i])/Subscript[T, 1]-(Subscript[p, 3,j] Subscript[x, 3,i])/(Subscript[T, 1] (-1+Subscript[T, 1] Subscript[T, 2]))-(Subscript[p, 1,j] Subscript[p, 3,i] Subscript[x, 1,i] Subscript[x, 3,i])/(\!\(
\*SubsuperscriptBox[\(T\), \(1\), \(2\)]\ \((\(-1\) + 
\*SubscriptBox[\(T\), \(1\)]\ 
\*SubscriptBox[\(T\), \(2\)])\)\))+(Subscript[p, 1,i] Subscript[p, 3,j] Subscript[x, 1,i] Subscript[x, 3,i])/((-1+Subscript[T, 1]) Subscript[T, 1] Subscript[T, 2])-(Subscript[p, 1,j] Subscript[p, 3,j] Subscript[x, 1,i] Subscript[x, 3,i])/(\!\(
\*SubsuperscriptBox[\(T\), \(1\), \(2\)]\ 
\*SubscriptBox[\(T\), \(2\)]\))-(Subscript[p, 1,j] Subscript[p, 3,i] Subscript[x, 1,j] Subscript[x, 3,i])/((-1+Subscript[T, 1]) Subscript[T, 1] (-1+Subscript[T, 1] Subscript[T, 2]))+((-1+Subscript[T, 2]) Subscript[p, 2,j] Subscript[p, 3,i] Subscript[x, 2,i] Subscript[x, 3,i])/(Subscript[T, 1] Subscript[T, 2] (-1+Subscript[T, 1] Subscript[T, 2]))+(Subscript[p, 2,i] Subscript[p, 3,j] Subscript[x, 2,i] Subscript[x, 3,i])/(\!\(
\*SubsuperscriptBox[\(T\), \(1\), \(2\)]\ 
\*SubscriptBox[\(T\), \(2\)]\))-((-1+2 Subscript[T, 2]) Subscript[p, 2,j] Subscript[p, 3,j] Subscript[x, 2,i] Subscript[x, 3,i])/(\!\(
\*SubsuperscriptBox[\(T\), \(1\), \(2\)]\ 
\*SubsuperscriptBox[\(T\), \(2\), \(2\)]\))+(Subscript[p, 2,j] Subscript[p, 3,i] Subscript[x, 2,j] Subscript[x, 3,i])/(Subscript[T, 1] (-1+Subscript[T, 1] Subscript[T, 2]))-(Subscript[p, 2,j] Subscript[p, 3,j] Subscript[x, 2,j] Subscript[x, 3,i])/(\!\(
\*SubsuperscriptBox[\(T\), \(1\), \(2\)]\ 
\*SubscriptBox[\(T\), \(2\)]\))+(Subscript[p, 1,i] Subscript[p, 3,j] Subscript[x, 1,i] Subscript[x, 3,j])/((-1+Subscript[T, 1]) (-1+Subscript[T, 1] Subscript[T, 2]))-(Subscript[p, 1,j] Subscript[p, 3,j] Subscript[x, 1,i] Subscript[x, 3,j])/(Subscript[T, 1] (-1+Subscript[T, 1] Subscript[T, 2]))-(Subscript[p, 2,j] Subscript[p, 3,j] Subscript[x, 2,i] Subscript[x, 3,j])/(Subscript[T, 1] (-1+Subscript[T, 1] Subscript[T, 2]))


(* ::Input::Initialization:: *)
g2px[\[ScriptCapitalE]_]:=Module[{\[Lambda]},Expand[\[ScriptCapitalE]/.Subscript[g, \[Alpha]_,i_,j_]:>\[Lambda] Subscript[p, \[Alpha],i] Subscript[x, \[Alpha],j]]/.\[Lambda]^k_.:>1/k!]


(* ::Input::Initialization:: *)
{SuperStar[p],SuperStar[x],SuperStar[\[Pi]],SuperStar[\[Xi]]}={\[Pi],\[Xi],p,x};  SuperStar[(Subscript[u_, i__])]:=Subscript[(SuperStar[u]), i];


(* ::Input::Initialization:: *)
\!\(\*SubscriptBox[\(Zip\), \({}\)]\)[\[ScriptCapitalE]_]:=\[ScriptCapitalE];
\!\(\*SubscriptBox[\(Zip\), \({\[Zeta]_, \[Zeta]s___}\)]\)[\[ScriptCapitalE]_] := (Collect[\[ScriptCapitalE]//\!\(\*SubscriptBox[\(Zip\), \({\[Zeta]s}\)]\),\[Zeta]] /. f_. \[Zeta]^d_.:>(D[f,{SuperStar[\[Zeta]],d}]))/.SuperStar[\[Zeta]]->0


(* ::Input::Initialization:: *)
px2g[\[ScriptCapitalE]_]:=Module[{ps,xs,Q},
ps=Union[Cases[\[ScriptCapitalE],Subscript[p, __],\[Infinity]]];
xs=Union[Cases[\[ScriptCapitalE],Subscript[x, __],\[Infinity]]];
Q=Sum[SuperStar[p0] SuperStar[x0] Subscript[g, p0[[2]],x0[[2]],p0[[3]],x0[[3]]],{p0,ps},{x0,xs}];
Expand[Subscript[Zip, ps\[Union]xs][\[ScriptCapitalE] E^Q]/.Subscript[g, \[Alpha]_,\[Beta]_,i_,j_]:>If[\[Alpha]===\[Beta],Subscript[g, \[Alpha],i,j],0]]
]


(* ::Input::Initialization:: *)
Subscript[R, 1][1,i_,j_]:=Evaluate[px2g[Subscript[r, 1][1,i,j]]+(Coefficient[Subscript[r, 1][1,i,j]/.t:Subscript[(x|p), __]:>\[Lambda] t, \[Lambda]^3]/.Subscript[x, 3,\[Alpha]_] Subscript[p, 1,\[Beta]_] Subscript[p, 2,\[Gamma]_]:>Subscript[y, \[Alpha],\[Beta],\[Gamma]])]
Subscript[R, 1][-1,i_,j_]:=Evaluate[px2g[Subscript[r, 1][-1,i,j]]+(Coefficient[Subscript[r, 1][-1,i,j]/.t:Subscript[(x|p), __]:>\[Lambda] t, \[Lambda]^3]/.Subscript[x, 3,\[Alpha]_] Subscript[p, 1,\[Beta]_] Subscript[p, 2,\[Gamma]_]:>Subscript[y, \[Alpha],\[Beta],\[Gamma]])]
Subscript[Piv, i_]:=-(1/(Subscript[T, 1] (-1+Subscript[T, 1] Subscript[T, 2]))) Subscript[g, 3,i,i](*-(((-2+Subscript[T, 1]+Subscript[T, 2]) (-Subscript[T, 1]-Subscript[T, 2]+2 Subscript[T, 1] Subscript[T, 2]) Subscript[g, 3,i,i])/((-1+Subscript[T, 1]) (-1+Subscript[T, 2]) (-1+Subscript[T, 1] Subscript[T, 2])))*)


(* ::Input::Initialization:: *)
\[Theta][1,i_,j_,\[Alpha]_,\[Beta]_,\[Gamma]_]:=Evaluate[Subscript[r, 0][1,i,j]/.{Subscript[p, 3,j_]:>Subscript[g, 3,j,\[Alpha]],Subscript[x, 1,i_]:>Subscript[g, 1,\[Beta],i],Subscript[x, 2,i_]:>Subscript[g, 2,\[Gamma],i]}] ;(* The \[Theta] graph with light (pxx) vertex  at (1,i,j) and unspecified heavy (xpp) vertex *)
\[Theta][-1,i_,j_,\[Alpha]_,\[Beta]_,\[Gamma]_]:=Evaluate[Subscript[r, 0][-1,i,j]/.{Subscript[p, 3,j_]:>Subscript[g, 3,j,\[Alpha]],Subscript[x, 1,i_]:>Subscript[g, 1,\[Beta],i],Subscript[x, 2,i_]:>Subscript[g, 2,\[Gamma],i]}] ;(* The \[Theta] graph with light (pxx) vertex  at (-1,i,j) and unspecified heavy (xpp) vertex *)
\[Theta][1,5,8,21,22,23]


(* ::Input::Initialization:: *)
Subscript[T, 3]=Subscript[T, 1] Subscript[T, 2];
CF[\[ScriptCapitalE]_]:=Factor@Together[\[ScriptCapitalE]];
\[Lambda][K_]:=Module[{Cs,\[CurlyPhi],n,A,s,i,j,k,\[CapitalDelta],G,gEval,Y,yEval,c,\[Lambda]1},
{Cs,\[CurlyPhi]}=Rot[K]; n=Length[Cs];
A=IdentityMatrix[2n+1];
Cases[Cs,{s_,i_,j_}:>(A[[{i,j},{i+1,j+1}]]+=({
 {-T^s, T^s-1},
 {0, -1}
}))];
\[CapitalDelta]=T^((-Total[\[CurlyPhi]]-Total[Cs[[All,1]]])/2) Det[A];
G=Inverse[A];
gEval[\[ScriptCapitalE]_]:=CF[\[ScriptCapitalE]/.
{Subscript[g, 1,\[Alpha]_,\[Beta]_]:>(G[[\[Alpha],\[Beta]]]/.T->Subscript[T, 1]), Subscript[g, 2,\[Alpha]_,\[Beta]_]:>(G[[\[Alpha],\[Beta]]]/.T->Subscript[T, 2]),Subscript[g, 3,\[Alpha]_,\[Beta]_]:>(G[[\[Alpha],\[Beta]]]/.T->Subscript[T, 3])}];
Y[\[Alpha]_,\[Beta]_,\[Gamma]_]:=Y[\[Alpha],\[Beta],\[Gamma]]=Sum[{s,i,j}=c; (* The expectation value of Subscript[x, 3,\[Alpha]] Subscript[p, 1,\[Beta]] Subscript[p, 2,\[Gamma]]*)
\[Theta][s,i,j,\[Alpha],\[Beta],\[Gamma]],
{c,Cs}];
yEval[\[ScriptCapitalE]_]:=\[ScriptCapitalE]/.Subscript[y, \[Alpha]_,\[Beta]_,\[Gamma]_]:>Y[\[Alpha],\[Beta],\[Gamma]];
\[Lambda]1=\!\(
\*SubsuperscriptBox[\(\[Sum]\), \(k = 1\), \(n\)]\(
\*SubscriptBox[\(R\), \(1\)] @@ Cs[[k]]\)\) +\!\(
\*SubsuperscriptBox[\(\[Sum]\), \(k = 1\), \(2  n\)]\(\[CurlyPhi][[k]] 
\*SubscriptBox[\(Piv\), \(k\)]\)\);
{\[CapitalDelta],(1-Subscript[T, 3])(\[CapitalDelta]/.T->Subscript[T, 1])(\[CapitalDelta]/.T->Subscript[T, 2])(\[CapitalDelta]/.T->Subscript[T, 3])\[Lambda]1}//yEval//gEval//Factor
];
\[Theta][K_]:=Module[{L=\[Lambda][K]},{L[[1]],Subscript[T, 1]L[[2]]+(T D[L[[1]],T]/.T->Subscript[T, 3])(L[[1]]/.T->Subscript[T, 1])(L[[1]]/.T->Subscript[T, 2])}//Expand]


(* ::Input::Initialization:: *)
CF[\[ScriptCapitalE]_]:=Factor@Together[\[ScriptCapitalE]];
Subscript[N\[Lambda], p1_,p2_][K_]:=Module[{G1,G2,G3,\[CapitalDelta]1,\[CapitalDelta]2,\[CapitalDelta]3,A1,A2,A3,Cs,\[CurlyPhi],n,A,s,i,j,k,\[CapitalDelta],G,gEval,Y,yEval,c,\[Lambda]1},
{Cs,\[CurlyPhi]}=Rot[K]; n=Length[Cs];
A=IdentityMatrix[2n+1];
Cases[Cs,{s_,i_,j_}:>(A[[{i,j},{i+1,j+1}]]+=({
 {-T^s, T^s-1},
 {0, -1}
}))];
A1=A/.T->p1;A2=A/.T->p2;A3=A/.T->p1 p2;
\[CapitalDelta]1=p1^((-Total[\[CurlyPhi]]-Total[Cs[[All,1]]])/2) Det[A1];
\[CapitalDelta]2=p2^((-Total[\[CurlyPhi]]-Total[Cs[[All,1]]])/2) Det[A2];
\[CapitalDelta]3=(p1 p2)^((-Total[\[CurlyPhi]]-Total[Cs[[All,1]]])/2) Det[A3];
G1=Inverse[A1];G2=Inverse[A2];G3=Inverse[A3];
gEval[\[ScriptCapitalE]_]:=CF[\[ScriptCapitalE]/.
{Subscript[g, 1,\[Alpha]_,\[Beta]_]:>G1[[\[Alpha],\[Beta]]], Subscript[g, 2,\[Alpha]_,\[Beta]_]:>G2[[\[Alpha],\[Beta]]],Subscript[g, 3,\[Alpha]_,\[Beta]_]:>G3[[\[Alpha],\[Beta]]]}];
Y[\[Alpha]_,\[Beta]_,\[Gamma]_]:=Y[\[Alpha],\[Beta],\[Gamma]]=Sum[{s,i,j}=c; (* The expectation value of Subscript[x, 3,\[Alpha]] Subscript[p, 1,\[Beta]] Subscript[p, 2,\[Gamma]]*)
\[Theta][s,i,j,\[Alpha],\[Beta],\[Gamma]],
{c,Cs}]/.{Subscript[T, 1]->p1,Subscript[T, 2]->p2};
yEval[\[ScriptCapitalE]_]:=\[ScriptCapitalE]/.Subscript[y, \[Alpha]_,\[Beta]_,\[Gamma]_]:>Y[\[Alpha],\[Beta],\[Gamma]];
\[Lambda]1=\!\(
\*SubsuperscriptBox[\(\[Sum]\), \(k = 1\), \(n\)]\(
\*SubscriptBox[\(R\), \(1\)] @@ Cs[[k]]\)\) + \!\(
\*SubsuperscriptBox[\(\[Sum]\), \(k = 1\), \(2  n\)]\(\[CurlyPhi][[k]] 
\*SubscriptBox[\(Piv\), \(k\)]\)\)/.{Subscript[T, 1]->p1,Subscript[T, 2]->p2};
{\[CapitalDelta]1,(1-p1 p2)\[CapitalDelta]1 \[CapitalDelta]2 \[CapitalDelta]3 \[Lambda]1}//yEval//gEval//Expand
];


(* ::Input::Initialization:: *)
Subscript[Rrho, 1][s_,i_,j_]:=s(Subscript[g, j\[InvisibleComma]i](Subscript[g, j+1,j]+Subscript[g, j,j+1]-Subscript[g, i\[InvisibleComma]j])-Subscript[g, i\[InvisibleComma]i](Subscript[g, j,j+1]-1)-1/2);
\[Rho][K_]:=\[Rho][K]=Module[{Cs,\[CurlyPhi],n,A,s,i,j,k,\[CapitalDelta],G,\[Rho]1},
{Cs,\[CurlyPhi]}=Rot[K]; n=Length[Cs];
A=IdentityMatrix[2n+1];
Cases[Cs,{s_,i_,j_}:>(A[[{i,j},{i+1,j+1}]]+=({
 {-T^s, T^s-1},
 {0, -1}
}))];
\[CapitalDelta]=T^((-Total[\[CurlyPhi]]-Total[Cs[[All,1]]])/2) Det[A];
G=Inverse[A];
\[Rho]1=\!\(
\*SubsuperscriptBox[\(\[Sum]\), \(k = 1\), \(n\)]\(
\*SubscriptBox[\(Rrho\), \(1\)] @@ Cs[[k]]\)\) - \!\(
\*SubsuperscriptBox[\(\[Sum]\), \(k = 1\), \(2  n\)]\(\[CurlyPhi][[k]] \((
\*SubscriptBox[\(g\), \(k\[InvisibleComma]k\)] - 1/2)\)\)\);
Expand@Together@{\[CapitalDelta],\[CapitalDelta]^2 \[Rho]1/.Subscript[g, \[Alpha]_,\[Beta]_]:>G[[\[Alpha],\[Beta]]]}

];


(* ::Input::Initialization:: *)
ColFun[t_]:=If[t>0,{t,0,0},{0,0,t}]
Renorm[t_]:=If[t==0,0,Sign[t]Log[Abs[t]+10]]
Poly2Pic[P_]:=Module[{e1=Exponent[P,Subscript[T, 1]^-1],e2=Exponent[P,Subscript[T, 2]^-1],Mat},
If[P===0,P,Mat=Map[Renorm,Normal@SparseArray[CoefficientRules[Subscript[T, 1]^(e1+1) Subscript[T, 2]^(e2+1) P,{Subscript[T, 1],Subscript[T, 2]}]],{2}];
MatrixPlot[Mat(*,ColorFunction->(RGBColor[If[#==0,0,1],0,0]&)*)]]
]


(* ::Input::Initialization:: *)
PD[GST48]=PD[X[1,15,2,14],X[29,2,30,3],X[40,4,41,3],X[4,44,5,43],X[5,26,6,27],X[95,7,96,6],X[7,1,8,96],X[8,14,9,13],X[28,9,29,10],X[41,11,42,10],X[11,43,12,42],X[12,27,13,28],X[15,31,16,30],X[61,16,62,17],X[72,17,73,18],X[83,18,84,19],X[34,20,35,19],X[20,89,21,90],X[92,21,93,22],X[22,79,23,80],X[23,68,24,69],X[24,57,25,58],X[56,25,57,26],X[31,63,32,62],X[32,74,33,73],X[33,85,34,84],X[35,50,36,51],X[81,37,82,36],X[70,38,71,37],X[59,39,60,38],X[54,39,55,40],X[55,45,56,44],X[45,59,46,58],X[46,70,47,69],X[47,81,48,80],X[91,49,92,48],X[49,91,50,90],X[82,52,83,51],X[71,53,72,52],X[60,54,61,53],X[74,63,75,64],X[85,64,86,65],X[65,76,66,77],X[66,87,67,88],X[94,67,95,68],X[86,75,87,76],X[77,88,78,89],X[93,78,94,79]];


(* ::Input::Initialization:: *)

pp[x_]:=x+x^-1
u=pp[s]+pp[t]+pp[s t] +1;
v=pp[s^2 t]+pp[s t^2]+pp[s t^-1]+1;
Subscript[Monomials, k_][a_,b_]:=Flatten@Table[a ^m b^n,{m,0,k},{n,0,k-m}]


(* ::Input::Initialization:: *)
(*This code is not optimal and runs too slowly!*)
ToUV[Q_]:=Module[{P=Q/.{Subscript[T, 1]->s,Subscript[T, 2]->t},deg,degs,degt,ShiftP,UVMons,Coefs,sol,eqs,cr},
If[P==0,Return[0]];
deg=Exponent[P/.{t->s},s];
UVMons=Expand[Subscript[Monomials, deg][u,v]];
degs=Exponent[P/.s->1/s,s];
degt=Exponent[P/.t->1/t,t];

degs=Max@Append[Table[Exponent[\[Mu]/.s->1/s,s],{\[Mu],UVMons}],degs];
degt=Max@Append[Table[Exponent[\[Mu]/.t->1/t,t],{\[Mu],UVMons}],degt];
UVMons=s^degs t^degt UVMons//Expand;
ShiftP = Expand[P s^degs t^degt];


Coefs=Table[Subscript[f, i],{i,1,Length[UVMons]}];
cr=CoefficientRules[(UVMons . Coefs-ShiftP),{s,t}];
eqs=cr/.{(r_->w_):>w==0};
{sol}=
Solve[eqs,Coefs];

Subscript[Monomials, deg][U,V] . Coefs/.sol
]
ToUV[-(1/\!\(\*SubsuperscriptBox[\(T\), \(1\), \(2\)]\))-\!\(\*SubsuperscriptBox[\(T\), \(1\), \(2\)]\)-1/\!\(\*SubsuperscriptBox[\(T\), \(2\), \(2\)]\)-1/(\!\(
\*SubsuperscriptBox[\(T\), \(1\), \(2\)]\ 
\*SubsuperscriptBox[\(T\), \(2\), \(2\)]\))+1/(Subscript[T, 1] \!\(\*SubsuperscriptBox[\(T\), \(2\), \(2\)]\))+1/(\!\(
\*SubsuperscriptBox[\(T\), \(1\), \(2\)]\ 
\*SubscriptBox[\(T\), \(2\)]\))+Subscript[T, 1]/Subscript[T, 2]+Subscript[T, 2]/Subscript[T, 1]+\!\(
\*SubsuperscriptBox[\(T\), \(1\), \(2\)]\ 
\*SubscriptBox[\(T\), \(2\)]\)-\!\(\*SubsuperscriptBox[\(T\), \(2\), \(2\)]\)+Subscript[T, 1] \!\(\*SubsuperscriptBox[\(T\), \(2\), \(2\)]\)-\!\(
\*SubsuperscriptBox[\(T\), \(1\), \(2\)]\ 
\*SubsuperscriptBox[\(T\), \(2\), \(2\)]\)]
Renorm[t_]:=If[t==0,0,Sign[t]Log[Abs[t]+10]]
DrawUVPol[P_]:=Module[{Mat},
If[P===0,Return[P],Mat=Map[Renorm,Normal@SparseArray[CoefficientRules[U V P,{U,V}]],{2}]];
MatrixPlot[Mat]
]


(* ::Input::Initialization:: *)
DunfieldKnotList=ReadList["C:\\Users\\T15Roland\\Wiskunde\\Bn\\HigherRank\\nmd_random_knots.txt"]/.{i_Integer:>i+1};


(* ::Input::Initialization:: *)
Subscript[\[Delta], i_,j_]:=If[i===j,1,0];


(* ::Input::Initialization:: *)
Subscript[gRules, s_,i_,j_]:={
Subscript[g, \[Nu]_,i,\[Beta]_]:>Subscript[\[Delta], i,\[Beta]]+\!\(
\*SubsuperscriptBox[\(T\), \(\[Nu]\), \(s\)] 
\*SubscriptBox[\(g\), \(\[Nu], 
\*SuperscriptBox[\(i\), \(+\)], \[Beta]\)]\)+(1-\!\(\*SubsuperscriptBox[\(T\), \(\[Nu]\), \(s\)]\))Subscript[g, \[Nu],SuperPlus[j],\[Beta]],Subscript[g, \[Nu]_,j,\[Beta]_]:>Subscript[\[Delta], j,\[Beta]]+Subscript[g, \[Nu],SuperPlus[j],\[Beta]],
Subscript[g, \[Nu]_,\[Alpha]_,i]:>\!\(
\*SubsuperscriptBox[\(T\), \(\[Nu]\), \(-s\)] \((
\*SubscriptBox[\(g\), \(\[Nu], \[Alpha], 
\*SuperscriptBox[\(i\), \(+\)]\)] - 
\*SubscriptBox[\(\[Delta]\), \(\[Alpha], 
\*SuperscriptBox[\(i\), \(+\)]\)])\)\),Subscript[g, \[Nu]_,\[Alpha]_,j]:>Subscript[g, \[Nu],\[Alpha],SuperPlus[j]]-(1-\!\(\*SubsuperscriptBox[\(T\), \(\[Nu]\), \(s\)]\))Subscript[g, \[Nu],\[Alpha],i]-Subscript[\[Delta], \[Alpha],SuperPlus[j]]
};
gRules[Cs_List]:=Union@@((Subscript[gRules, Sequence@@#])&/@Cs)


(* ::Input::Initialization:: *)
Y[\[Alpha]_,\[Beta]_,\[Gamma]_]:=Module[{s,i,j},Sum[{s,i,j}=c;\[Theta][s,i,j,\[Alpha],\[Beta],\[Gamma]],{c,Cs}]];
yEval[\[ScriptCapitalE]_]:=\[ScriptCapitalE]/.Subscript[y, \[Alpha]_,\[Beta]_,\[Gamma]_]:>Y[\[Alpha],\[Beta],\[Gamma]];



