(* ::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\\Talks\\KnotTheoryCongress-2502"];
<< KnotTheory`
<< Rot.m


(* ::Input::Initialization:: *)
T2z[p_]:=Module[{q=Expand[p],n,c},
If[q===0,0,c=Coefficient[q,T,n=Exponent[q,T]];c z^(2n)+T2z[q-c (T^(1/2)-T^(-1/2))^(2n)]]];


(* ::Input::Initialization:: *)
CF[\[ScriptCapitalE]_] := Expand@Collect[\[ScriptCapitalE],Subscript[g, __],F]/.F->Factor;


(* ::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]_]:=CF@Module[{ps,xs,Q,\[Alpha],\[Beta]},
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,ps},{x0,xs}];
Expand[Subscript[Zip, ps\[Union]xs][\[ScriptCapitalE] E^Q]]
]


(* ::Input::Initialization:: *)
q[s_,i_,j_]:=Subscript[x, i] (Subscript[p, i+1]-Subscript[p, i])+Subscript[x, j] (Subscript[p, j+1]-Subscript[p, j])+(T^s-1)Subscript[x, i](Subscript[p, i+1]-Subscript[p, j+1]);
Subscript[r, 1][s_,i_,j_]:=s/2 (Subscript[x, i](Subscript[p, i]-Subscript[p, j])((T^s-1)Subscript[x, i] Subscript[p, j]+2(1-Subscript[p, j] Subscript[x, j]))-1);
Subscript[r, 2][1,i_,j_]:=(-6 Subscript[p, i] Subscript[x, i]+6 Subscript[p, j] Subscript[x, i]-3 (-1+3 T) Subscript[p, i] Subscript[p, j] \!\(\*SubsuperscriptBox[\(x\), \(i\), \(2\)]\)+3 (-1+3 T) \!\(\*SubsuperscriptBox[\(p\), \(j\), \(2\)]\) \!\(\*SubsuperscriptBox[\(x\), \(i\), \(2\)]\)+4 (-1+T) \!\(\*SubsuperscriptBox[\(p\), \(i\), \(2\)]\) Subscript[p, j] \!\(\*SubsuperscriptBox[\(x\), \(i\), \(3\)]\)-2 (-1+T) (5+T) Subscript[p, i] \!\(\*SubsuperscriptBox[\(p\), \(j\), \(2\)]\) \!\(\*SubsuperscriptBox[\(x\), \(i\), \(3\)]\)+2 (-1+T) (3+T) \!\(\*SubsuperscriptBox[\(p\), \(j\), \(3\)]\) \!\(\*SubsuperscriptBox[\(x\), \(i\), \(3\)]\)+18 Subscript[p, i] Subscript[p, j] Subscript[x, i] Subscript[x, j]-18 \!\(\*SubsuperscriptBox[\(p\), \(j\), \(2\)]\) Subscript[x, i] Subscript[x, j]-6 \!\(\*SubsuperscriptBox[\(p\), \(i\), \(2\)]\) Subscript[p, j] \!\(\*SubsuperscriptBox[\(x\), \(i\), \(2\)]\) Subscript[x, j]+6 (2+T) Subscript[p, i] \!\(\*SubsuperscriptBox[\(p\), \(j\), \(2\)]\) \!\(\*SubsuperscriptBox[\(x\), \(i\), \(2\)]\) Subscript[x, j]-6 (1+T) \!\(\*SubsuperscriptBox[\(p\), \(j\), \(3\)]\) \!\(\*SubsuperscriptBox[\(x\), \(i\), \(2\)]\) Subscript[x, j]-6 Subscript[p, i] \!\(\*SubsuperscriptBox[\(p\), \(j\), \(2\)]\) Subscript[x, i] \!\(\*SubsuperscriptBox[\(x\), \(j\), \(2\)]\)+6 \!\(\*SubsuperscriptBox[\(p\), \(j\), \(3\)]\) Subscript[x, i] \!\(\*SubsuperscriptBox[\(x\), \(j\), \(2\)]\))/12;
Subscript[r, 2][-1,i_,j_]:=(-6 T^2 Subscript[p, i] Subscript[x, i]+6 T^2 Subscript[p, j] Subscript[x, i]+3 (-3+T) T Subscript[p, i] Subscript[p, j] \!\(\*SubsuperscriptBox[\(x\), \(i\), \(2\)]\)-3 (-3+T) T \!\(\*SubsuperscriptBox[\(p\), \(j\), \(2\)]\) \!\(\*SubsuperscriptBox[\(x\), \(i\), \(2\)]\)-4 (-1+T) T \!\(\*SubsuperscriptBox[\(p\), \(i\), \(2\)]\) Subscript[p, j] \!\(\*SubsuperscriptBox[\(x\), \(i\), \(3\)]\)+2 (-1+T) (1+5 T) Subscript[p, i] \!\(\*SubsuperscriptBox[\(p\), \(j\), \(2\)]\) \!\(\*SubsuperscriptBox[\(x\), \(i\), \(3\)]\)-2 (-1+T) (1+3 T) \!\(\*SubsuperscriptBox[\(p\), \(j\), \(3\)]\) \!\(\*SubsuperscriptBox[\(x\), \(i\), \(3\)]\)+18 T^2 Subscript[p, i] Subscript[p, j] Subscript[x, i] Subscript[x, j]-18 T^2 \!\(\*SubsuperscriptBox[\(p\), \(j\), \(2\)]\) Subscript[x, i] Subscript[x, j]-6 T^2 \!\(\*SubsuperscriptBox[\(p\), \(i\), \(2\)]\) Subscript[p, j] \!\(\*SubsuperscriptBox[\(x\), \(i\), \(2\)]\) Subscript[x, j]+6 T (1+2 T) Subscript[p, i] \!\(\*SubsuperscriptBox[\(p\), \(j\), \(2\)]\) \!\(\*SubsuperscriptBox[\(x\), \(i\), \(2\)]\) Subscript[x, j]-6 T (1+T) \!\(\*SubsuperscriptBox[\(p\), \(j\), \(3\)]\) \!\(\*SubsuperscriptBox[\(x\), \(i\), \(2\)]\) Subscript[x, j]-6 T^2 Subscript[p, i] \!\(\*SubsuperscriptBox[\(p\), \(j\), \(2\)]\) Subscript[x, i] \!\(\*SubsuperscriptBox[\(x\), \(j\), \(2\)]\)+6 T^2 \!\(\*SubsuperscriptBox[\(p\), \(j\), \(3\)]\) Subscript[x, i] \!\(\*SubsuperscriptBox[\(x\), \(j\), \(2\)]\))/(12T^2);
Subscript[\[Gamma], 1][\[CurlyPhi]_,k_]:=\[CurlyPhi](1/2-Subscript[x, k] Subscript[p, k]);
Subscript[\[Gamma], 2][\[CurlyPhi]_,k_]:=-\[CurlyPhi]^2 Subscript[p, k]Subscript[x, k]/2;
\[ScriptCapitalL][Subscript[X, i_,j_][s_]]:=T^(s/2) \[DoubleStruckCapitalE][q[s,i,j]+\[Epsilon] Subscript[r, 1][s,i,j]+\[Epsilon]^2 Subscript[r, 2][s,i,j]+O[\[Epsilon]]^3];
\[ScriptCapitalL][Subscript[C, k_][\[CurlyPhi]_]]:=T^(\[CurlyPhi]/2) \[DoubleStruckCapitalE][-Subscript[x, k](Subscript[p, k]-Subscript[p, k+1])+\[Epsilon] Subscript[\[Gamma], 1][\[CurlyPhi],k]+\[Epsilon]^2 Subscript[\[Gamma], 2][\[CurlyPhi],k]+O[\[Epsilon]]^3];
\[ScriptCapitalL][K_]:=(2\[Pi])^-Features[K][[1]] CF[\[ScriptCapitalL]/@Features[K][[2]]];
vs[K_] := Union@@Table[{Subscript[p, i],Subscript[x, i]},{i,Features[K][[1]]}]


(* ::Input::Initialization:: *)
F[Subscript[X, i_,j_][1]]=px2g[Subscript[r, 2][1,i,j]+Subscript[r, 1][1,i,j]^2/2]


(* ::Input::Initialization:: *)
F[Subscript[X, i_,j_][-1]]=px2g[Subscript[r, 2][-1,i,j]+Subscript[r, 1][-1,i,j]^2/2]


(* ::Input::Initialization:: *)
Short[F[Subscript[X, i0_,j0_][1]Subscript[X, i1_,j1_][1]]=px2g[Subscript[r, 1][1,i0,j0]Subscript[r, 1][1,i1,j1]]]


(* ::Input::Initialization:: *)
Short[F[Subscript[X, i0_,j0_][1]Subscript[X, i1_,j1_][-1]]=px2g[Subscript[r, 1][1,i0,j0]Subscript[r, 1][-1,i1,j1]]]


(* ::Input::Initialization:: *)
Short[F[Subscript[X, i0_,j0_][-1]Subscript[X, i1_,j1_][-1]]=px2g[Subscript[r, 1][-1,i0,j0]Subscript[r, 1][-1,i1,j1]]]


(* ::Input::Initialization:: *)
F[Subscript[C, k_][1]]=px2g[Subscript[\[Gamma], 2][1,k]+Subscript[\[Gamma], 1][1,k]^2/2]


(* ::Input::Initialization:: *)
F[Subscript[C, k_][-1]]=px2g[Subscript[\[Gamma], 2][-1,k]+Subscript[\[Gamma], 1][-1,k]^2/2]


(* ::Input::Initialization:: *)
F[Subscript[X, i_,j_][1]Subscript[C, k_][1]]=px2g[Subscript[r, 1][1,i,j]Subscript[\[Gamma], 1][1,k]]


(* ::Input::Initialization:: *)
F[Subscript[X, i_,j_][1]Subscript[C, k_][-1]]=px2g[Subscript[r, 1][1,i,j]Subscript[\[Gamma], 1][-1,k]]


(* ::Input::Initialization:: *)
F[Subscript[X, i_,j_][-1]Subscript[C, k_][1]]=px2g[Subscript[r, 1][-1,i,j]Subscript[\[Gamma], 1][1,k]]


(* ::Input::Initialization:: *)
F[Subscript[X, i_,j_][-1]Subscript[C, k_][-1]]=px2g[Subscript[r, 1][-1,i,j]Subscript[\[Gamma], 1][-1,k]]


(* ::Input::Initialization:: *)
F[Subscript[C, k0_][1]Subscript[C, k1_][1]]=px2g[Subscript[\[Gamma], 1][1,k0]Subscript[\[Gamma], 1][1,k1]]


(* ::Input::Initialization:: *)
F[Subscript[C, k0_][1]Subscript[C, k1_][-1]]=px2g[Subscript[\[Gamma], 1][1,k0]Subscript[\[Gamma], 1][-1,k1]]


(* ::Input::Initialization:: *)
F[Subscript[C, k0_][-1]Subscript[C, k1_][-1]]=px2g[Subscript[\[Gamma], 1][-1,k0]Subscript[\[Gamma], 1][-1,k1]]


(* ::Input::Initialization:: *)
Subscript[\[Rho], 2][K_]:=Module[{n,Fs,Xs,Cs,A,w,\[CurlyPhi],\[CapitalDelta],G},
{n,Fs}=List@@Features[K]; {++n, Xs=Cases[Fs,Subscript[X, __][_]], Cs=Cases[Fs,Subscript[C, _][_]]};
A=IdentityMatrix[n]; w=\[CurlyPhi]=0;
Xs/.Subscript[X, i_,j_][s_]:>(w+=s; A[[{i,j},{i+1,j+1}]]+=({
 {-T^s, T^s-1},
 {0, -1}
}));
Cs/.Subscript[C, k_][\[Phi]_]:>(\[CurlyPhi]+=\[Phi]; A[[k,k+1]]+=-1);
\[CapitalDelta]=T^(-(\[CurlyPhi]+w)/2) Det[A];
G=Inverse[A];
Factor[2\[CapitalDelta]^4 Total@Factor[(F/@Subsets[Fs,{1,2}])/.Subscript[g, \[Alpha]_,\[Beta]_]:>G[[\[Alpha],\[Beta]]]]]
]


(* ::Input::Initialization:: *)
DunfieldKnots=ReadList["../../People/Dunfield/nmd_random_knots"]/.k_Integer:>k+1;
DK[n_]:=DunfieldKnots[[n-2]];



