(* ::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["~/AcademicPensieve/Projects/HigherRank/Data"];
(*SetDirectory["C:\\drorbn\\AcademicPensieve\\Projects\\HigherRank\\Data"];*)
<<../../KnotTheory/KnotTheory/init.m
AppendTo[$Path,KnotTheoryDirectory[]="../../KnotTheory"];
Print[$Path=Cases[$Path, _String]];
<<../Rot.m
Subscript[T, 3]=Subscript[T, 1] Subscript[T, 2];


(* ::Input::Initialization:: *)
CCF[\[ScriptCapitalE]_] := ExpandDenominator@ExpandNumerator@Together[\[ScriptCapitalE]];
CCF[\[ScriptCapitalE]_] := Factor[\[ScriptCapitalE]];
CF[\[ScriptCapitalE]_List]:=CF/@\[ScriptCapitalE];
CF[\[ScriptCapitalE]_] := Module[{vs=Cases[\[ScriptCapitalE],Subscript[(x|p|\[Pi]|g), __],\[Infinity]]\[Union]{x,p,\[Epsilon]},ps,c},
Total[CoefficientRules[Expand[\[ScriptCapitalE]], vs] /. (ps_->c_) :> CCF[c](Times@@(vs^ps))] ];


(* ::Input::Initialization:: *)
Subscript[R, 1][1,i_,j_]=CF[
1/2-Subscript[T, 3] Subscript[g, 1\[InvisibleComma]j\[InvisibleComma]i] Subscript[g, 2\[InvisibleComma]j\[InvisibleComma]i]-Subscript[g, 3\[InvisibleComma]i\[InvisibleComma]i]+Subscript[g, 2\[InvisibleComma]j\[InvisibleComma]j] Subscript[g, 3\[InvisibleComma]i\[InvisibleComma]i]+Subscript[T, 1](Subscript[T, 3]-1)Subscript[g, 1\[InvisibleComma]j\[InvisibleComma]i] Subscript[g, 3\[InvisibleComma]j\[InvisibleComma]i]+Subscript[T, 2](Subscript[T, 3]-1)Subscript[g, 2\[InvisibleComma]j\[InvisibleComma]i] Subscript[g, 3\[InvisibleComma]j\[InvisibleComma]i]-Subscript[T, 2] Subscript[g, 2\[InvisibleComma]j\[InvisibleComma]i] Subscript[g, 3\[InvisibleComma]j\[InvisibleComma]j]+(Subscript[g, 1\[InvisibleComma]j\[InvisibleComma]j] Subscript[g, 2\[InvisibleComma]i\[InvisibleComma]i]+(Subscript[T, 3]-1)Subscript[g, 1\[InvisibleComma]j\[InvisibleComma]j] Subscript[g, 2\[InvisibleComma]j\[InvisibleComma]i]-Subscript[T, 1] Subscript[g, 1\[InvisibleComma]i\[InvisibleComma]i] Subscript[g, 2\[InvisibleComma]j\[InvisibleComma]j]-Subscript[g, 1\[InvisibleComma]j\[InvisibleComma]j] Subscript[g, 3\[InvisibleComma]i\[InvisibleComma]i]-Subscript[T, 1](Subscript[T, 3]-1)Subscript[g, 1\[InvisibleComma]j\[InvisibleComma]j] Subscript[g, 3\[InvisibleComma]j\[InvisibleComma]i]+Subscript[T, 1] Subscript[g, 1\[InvisibleComma]i\[InvisibleComma]i] Subscript[g, 3\[InvisibleComma]j\[InvisibleComma]j])/(Subscript[T, 1]-1)];


(* ::Input::Initialization:: *)
Subscript[R, 1][-1,i_,j_]=CF[
-1/2-\!\(
\*SubsuperscriptBox[\(T\), \(1\), \(-1\)] 
\*SubscriptBox[\(g\), \(1\[InvisibleComma]j\[InvisibleComma]i\)] 
\*SubscriptBox[\(g\), \(2\[InvisibleComma]i\[InvisibleComma]i\)]\)-(1-\!\(\*SubsuperscriptBox[\(T\), \(1\), \(-1\)]\)-\!\(\*SubsuperscriptBox[\(T\), \(2\), \(-1\)]\))Subscript[g, 1\[InvisibleComma]j\[InvisibleComma]i] Subscript[g, 2\[InvisibleComma]j\[InvisibleComma]i]-Subscript[g, 1\[InvisibleComma]j\[InvisibleComma]j] Subscript[g, 2\[InvisibleComma]j\[InvisibleComma]i]-Subscript[g, 1\[InvisibleComma]j\[InvisibleComma]i] Subscript[g, 2\[InvisibleComma]j\[InvisibleComma]j]+Subscript[g, 3\[InvisibleComma]i\[InvisibleComma]i]+\!\(
\*SubsuperscriptBox[\(T\), \(1\), \(-1\)] 
\*SubscriptBox[\(g\), \(1\[InvisibleComma]j\[InvisibleComma]i\)] 
\*SubscriptBox[\(g\), \(3\[InvisibleComma]i\[InvisibleComma]i\)]\)-(1-\!\(\*SubsuperscriptBox[\(T\), \(2\), \(-1\)]\))Subscript[g, 2\[InvisibleComma]j\[InvisibleComma]i] Subscript[g, 3\[InvisibleComma]i\[InvisibleComma]i]-Subscript[g, 2\[InvisibleComma]j\[InvisibleComma]j] Subscript[g, 3\[InvisibleComma]i\[InvisibleComma]i]+(1-\!\(\*SubsuperscriptBox[\(T\), \(3\), \(-1\)]\))Subscript[g, 1\[InvisibleComma]j\[InvisibleComma]i] Subscript[g, 3\[InvisibleComma]j\[InvisibleComma]i]-(1-\!\(\*SubsuperscriptBox[\(T\), \(3\), \(-1\)]\))Subscript[g, 2\[InvisibleComma]i\[InvisibleComma]i] Subscript[g, 3\[InvisibleComma]j\[InvisibleComma]i]+(2-\!\(\*SubsuperscriptBox[\(T\), \(2\), \(-1\)]\))(1-\!\(\*SubsuperscriptBox[\(T\), \(3\), \(-1\)]\))Subscript[g, 2\[InvisibleComma]j\[InvisibleComma]i] Subscript[g, 3\[InvisibleComma]j\[InvisibleComma]i]+(1-\!\(\*SubsuperscriptBox[\(T\), \(3\), \(-1\)]\))Subscript[g, 2\[InvisibleComma]j\[InvisibleComma]j] Subscript[g, 3\[InvisibleComma]j\[InvisibleComma]i]+Subscript[g, 1\[InvisibleComma]j\[InvisibleComma]i] Subscript[g, 3\[InvisibleComma]j\[InvisibleComma]j]+Subscript[g, 2\[InvisibleComma]j\[InvisibleComma]i] Subscript[g, 3\[InvisibleComma]j\[InvisibleComma]j]+(Subscript[T, 1](1-\!\(\*SubsuperscriptBox[\(T\), \(2\), \(-1\)]\))Subscript[g, 1\[InvisibleComma]i\[InvisibleComma]i] Subscript[g, 2\[InvisibleComma]j\[InvisibleComma]i]-Subscript[g, 1\[InvisibleComma]j\[InvisibleComma]j] Subscript[g, 2\[InvisibleComma]i\[InvisibleComma]i]+Subscript[T, 1] Subscript[g, 1\[InvisibleComma]i\[InvisibleComma]i] Subscript[g, 2\[InvisibleComma]j\[InvisibleComma]j]+Subscript[g, 1\[InvisibleComma]j\[InvisibleComma]j] Subscript[g, 3\[InvisibleComma]i\[InvisibleComma]i]-\!\(
\*SubsuperscriptBox[\(T\), \(2\), \(-1\)] \((
\*SubscriptBox[\(T\), \(3\)] - 1)\) 
\*SubscriptBox[\(g\), \(1\[InvisibleComma]i\[InvisibleComma]i\)] 
\*SubscriptBox[\(g\), \(3\[InvisibleComma]j\[InvisibleComma]i\)]\)-Subscript[T, 1] Subscript[g, 1\[InvisibleComma]i\[InvisibleComma]i] Subscript[g, 3\[InvisibleComma]j\[InvisibleComma]j])/(Subscript[T, 1]-1)];


(* ::Input::Initialization:: *)
\[Theta][{1,i0_,j0_},{1,i1_,j1_}]=-Subscript[T, 1](Subscript[T, 3]-1)Subscript[g, 1,j1,i0] Subscript[g, 2,i1,i0] Subscript[g, 3,j0,i1]+(Subscript[T, 3]-1)Subscript[g, 1,j1,j0] Subscript[g, 2,i1,i0] Subscript[g, 3,j0,i1]+Subscript[T, 1](Subscript[T, 3]-1)Subscript[g, 1,j1,i0] Subscript[g, 2,j1,i0] Subscript[g, 3,j0,i1]-(Subscript[T, 3]-1)Subscript[g, 1,j1,j0] Subscript[g, 2,j1,i0] Subscript[g, 3,j0,i1];


(* ::Input::Initialization:: *)
\[Theta][{1,i0_,j0_},{-1,i1_,j1_}]=(Subscript[T, 3]-1)Subscript[g, 1,j1,i0] Subscript[g, 2,i1,i0] Subscript[g, 3,j0,i1]-\!\(
\*SubsuperscriptBox[\(T\), \(1\), \(-1\)] \((
\*SubscriptBox[\(T\), \(3\)] - 1)\) 
\*SubscriptBox[\(g\), \(1, j1, j0\)] 
\*SubscriptBox[\(g\), \(2, i1, i0\)] 
\*SubscriptBox[\(g\), \(3, j0, i1\)]\)-(Subscript[T, 3]-1)Subscript[g, 1,j1,i0] Subscript[g, 2,j1,i0] Subscript[g, 3,j0,i1]+\!\(
\*SubsuperscriptBox[\(T\), \(1\), \(-1\)] \((
\*SubscriptBox[\(T\), \(3\)] - 1)\) 
\*SubscriptBox[\(g\), \(1, j1, j0\)] 
\*SubscriptBox[\(g\), \(2, j1, i0\)] 
\*SubscriptBox[\(g\), \(3, j0, i1\)]\);


(* ::Input::Initialization:: *)
\[Theta][{-1,i0_,j0_},{1,i1_,j1_}]=CF[
\!\(
\*SubsuperscriptBox[\(T\), \(1\), \(-1\)] 
\*SubsuperscriptBox[\(T\), \(2\), \(-1\)] \((
\*SubscriptBox[\(T\), \(3\)] - 1)\) \((
\*SubscriptBox[\(g\), \(1, j1, i0\)] 
\*SubscriptBox[\(g\), \(2, i1, i0\)] 
\*SubscriptBox[\(g\), \(3, j0, i1\)] - 
\*SubscriptBox[\(T\), \(1\)] 
\*SubscriptBox[\(g\), \(1, j1, j0\)] 
\*SubscriptBox[\(g\), \(2, i1, i0\)] 
\*SubscriptBox[\(g\), \(3, j0, i1\)] - 
\*SubscriptBox[\(g\), \(1, j1, i0\)] 
\*SubscriptBox[\(g\), \(2, j1, i0\)] 
\*SubscriptBox[\(g\), \(3, j0, i1\)] + 
\*SubscriptBox[\(T\), \(1\)] 
\*SubscriptBox[\(g\), \(1, j1, j0\)] 
\*SubscriptBox[\(g\), \(2, j1, i0\)] 
\*SubscriptBox[\(g\), \(3, j0, i1\)])\)\)];


(* ::Input::Initialization:: *)
\[Theta][{-1,i0_,j0_},{-1,i1_,j1_}]=CF[
(1-\!\(\*SubsuperscriptBox[\(T\), \(3\), \(-1\)]\)) (-\!\(\*SubsuperscriptBox[\(T\), \(1\), \(-1\)]\) Subscript[g, 1,j1,i0] Subscript[g, 2,i1,i0] Subscript[g, 3,j0,i1]+Subscript[g, 1,j1,j0] Subscript[g, 2,i1,i0] Subscript[g, 3,j0,i1]+\!\(
\*SubsuperscriptBox[\(T\), \(1\), \(-1\)] 
\*SubscriptBox[\(g\), \(1, j1, i0\)]\ 
\*SubscriptBox[\(g\), \(2, j1, i0\)]\ 
\*SubscriptBox[\(g\), \(3, j0, i1\)]\)-Subscript[g, 1,j1,j0] Subscript[g, 2,j1,i0] Subscript[g, 3,j0,i1])];


(* ::Input::Initialization:: *)
Subscript[\[CapitalGamma], 1][\[CurlyPhi]_,k_]=-\[CurlyPhi]/2+\[CurlyPhi] Subscript[g, 3,k,k];


(* ::Input::Initialization:: *)
\[Theta][K_]:=Module[{Cs,\[CurlyPhi],n,A,s,i,j,k,\[CapitalDelta],G,\[Nu],\[Alpha],\[Beta],gEval,c,z},
{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]_]:=Factor[\[ScriptCapitalE]/.Subscript[g, \[Nu]_,\[Alpha]_,\[Beta]_]:>(G[[\[Alpha],\[Beta]]]/.T->Subscript[T, \[Nu]])];
z=gEval[Sum[\[Theta][Cs[[k1]],Cs[[k2]]],{k1,n},{k2,n}]];
z+=gEval@Sum[Subscript[R, 1]@@Cs[[k]],{k,n}];
z+=gEval@Sum[Subscript[\[CapitalGamma], 1][\[CurlyPhi][[k]],k],{k,2n}];
{\[CapitalDelta],(\[CapitalDelta]/.T->Subscript[T, 1])(\[CapitalDelta]/.T->Subscript[T, 2])(\[CapitalDelta]/.T->Subscript[T, 3])z}//Factor ];


(* ::Input::Initialization:: *)
AbsoluteTiming[
Table[Echo[K]->(\[Theta][K]/.{Subscript[T, 1]->T1,Subscript[T, 2]->T2}),{K,AllKnots[{15,15}][[200001;;253293]]}] >> "theta15(200001-253293).m"
]



