(* ::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\\2024-03"];
Once[<< KnotTheory`];


(* ::Input::Initialization:: *)
CF[\[ScriptCapitalE]_]:=Expand[\[ScriptCapitalE]];


(* ::Input::Initialization:: *)
SetAttributes[{B,M}, Orderless]; (* B for Boundary, M for Marked *)
CF[b_B]:=RotateLeft[#,First@Ordering[#]-1]&/@DeleteCases[b,{}];


(* ::Input::Initialization:: *)
CF[Subscript[G, b_][f_]]:=Subscript[G, CF[b]][CF[f]]


(* ::Input::Initialization:: *)
Subscript[G, b1_][f1_]\[CirclePlus]Subscript[G, b2_][f2_]^:=CF@Subscript[G, Join[b1,b2]][Expand[f1 f2]/.{M[m1___]M[m2___]:>M[m1,m2], M[]^2->M[]}];


(* ::Input::Initialization:: *)
Subscript[GT, i_,j_]@Subscript[G, B[{li___,i_,ri___},{lj___,j_,rj___},bs___]][f_]:=CF@Subscript[G, B[{ri,li,j,rj,lj,i},bs]][f/.{
M[i,j,___]->0,M[i|j,ms___]:>M[i,j,ms],M[ms___]:>M[i,ms]+M[j,ms]
}]


(* ::Input::Initialization:: *)
Subscript[Cordon, i_]@Subscript[G, B[{li___,i_,ri___},bs___]][f_]:=Module[{j1,j2},
{j1,j2}={First@{ri,li},Last@{ri,li}};
CF@Subscript[G, B[Most@{ri,li},bs]][f
/.{M[i,ms___]:>M[ms],M[___]->0}
/.{M[j1,j2,___]->0,M[j2,ms___]:>M[j1,ms]}
]
]


(* ::Input::Initialization:: *)
Subscript[c, i_,j_]@t:Subscript[G, B[{li___,i_,ri___},{___,j_,___},___]][__]:=t//Subscript[GT, j,First@{ri,li}]//Subscript[Cordon, j]


(* ::Input::Initialization:: *)
Subscript[c, i_,j_]@t:Subscript[G, B[{___,i_,j_,___},___]][__]:=Subscript[Cordon, j]@t
Subscript[c, i_,j_]@t:Subscript[G, B[{j_,___,i_},___]][__]:=Subscript[Cordon, j]@t
Subscript[c, i_,j_]@t:Subscript[G, B[{___,j_,i_,___},___]][__]:=Subscript[Cordon, i]@t
Subscript[c, i_,j_]@t:Subscript[G, B[{i_,___,j_},___]][__]:=Subscript[Cordon, i]@t


(* ::Input::Initialization:: *)
mc[\[ScriptCapitalE]_]:=\[ScriptCapitalE]//.
t:Subscript[G, B[{___,i_,___},{___,j_,___},___]][__]|Subscript[G, B[{___,i_,j_,___},___]][__]|Subscript[G, B[{j_,___,i_},___]][__]/;i+j==0:>Subscript[c, i,j]@t


(* ::Input::Initialization:: *)
KSI@Subscript[P, i_,j_]:=CF@Subscript[G, B[{i,j}]][M[]];
KSI[x:X[i_,j_,k_,l_]]:=KSI@If[PositiveQ[x],Subscript[X, -i,j,k,-l],Subscript[\!\(\*OverscriptBox[\(X\), \(_\)]\), -j,k,l,-i]];
KSI[Subscript[X, i_,j_,k_,l_]]:=CF@Subscript[G, B[{i,j,k,l}]][\[Mu] T^-1 M[i]+T M[k]+M[l]+M[j]];
KSI[Subscript[\!\(\*OverscriptBox[\(X\), \(_\)]\), i_,j_,k_,l_]]:=CF@Subscript[G, B[{i,j,k,l}]][\[Mu] T M[i]+T^-1 M[k]+M[l]+M[j]];
KSI[K_]:=Fold[mc[#1\[CirclePlus]#2]&,Subscript[G, B[]][1],List@@(KSI/@PD@K)];


(* ::Input::Initialization:: *)
Cut[pd_PD]:=Module[{n=Length[pd]},
pd/.{X[2n,i_,1,j_]:>X[2n,i,2n+1,j],X[i_,1,j_,2n]:>X[i,2n+1,j,2n],X[i_,2n,j_,1]:>X[i,2n,j,2n+1]}
];
KSIK[K_]:=KSI[Cut@PD@K][[1]]/.{M[]->1,T->T^(1/2),\[Mu]->-1}


(* ::Input::Initialization:: *)
TC[K_]:=KSI[Cut@PD@K][[1]]/.{M[]->1, T->1,\[Mu]->1}



