(* ::Package:: *)

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

(* ::Input::Initialization:: *)
SetDirectory["C:\\drorbn\\AcademicPensieve\\Talks\\ICERM-2305"];


(* ::Input::Initialization:: *)
Once[<< KnotTheory`];


(* ::Input::Initialization:: *)
\[Theta][x_]/;NumericQ[x]:=UnitStep[x]


(* ::Input::Initialization:: *)
\[Omega]2[v_][p_]:=Module[{q=Expand[p],n,c},
If[q===0,0,c=Coefficient[q,\[Omega],n=Exponent[q,\[Omega]]];c v^n+\[Omega]2[v][q-c (\[Omega]+\[Omega]^-1)^n]]];


(* ::Input::Initialization:: *)
sign[\[ScriptCapitalE]_]:=Module[{n,d,v,p,rs,e,k},
{n,d}=NumeratorDenominator[\[ScriptCapitalE]];
{n,d}/=\[Omega]^(Exponent[n,\[Omega]]/2+Exponent[n,\[Omega],Min]/2);
p=Factor[\[Omega]2[v]@n*\[Omega]2[v]@d/.v->4u^2-2];
rs=Solve[p==0,u,Reals];
If[rs==={}, Sign[p/.u->0],
rs=Union@(u/.rs);
Sign[(-1)^(e=Exponent[p,u]) Coefficient[p,u,e]]+Sum[
k=0;While[(d=RootReduce[\!\(
\*SubscriptBox[\(\[PartialD]\), \({u, \(++k\)}\)]p\)/.u->r])==0];
If[EvenQ[k],0,2Sign[d]]*\[Theta][u-r],
{r,rs}]
]
]


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


(* ::Input::Initialization:: *)
CF[\[ScriptCapitalE]_]:=Module[{\[Gamma]s=Union@Cases[\[ScriptCapitalE],Subscript[\[Gamma], _]|Subscript[\!\(\*OverscriptBox[\(\[Gamma]\), \(_\)]\), _],\[Infinity]]},
Total[CoefficientRules[\[ScriptCapitalE],\[Gamma]s]/.(ps_->c_):>Factor[c]Times@@(\[Gamma]s^ps)] ]


(* ::Input::Initialization:: *)
CF[{}]={};
CF[\[ScriptCapitalC]_List]:=Module[{\[Gamma]s=Union@Cases[\[ScriptCapitalC],Subscript[\[Gamma], _],\[Infinity]],\[Gamma]},
CF/@DeleteCases[0][
RowReduce[Table[\!\(
\*SubscriptBox[\(\[PartialD]\), \(\[Gamma]\)]r\),{r,\[ScriptCapitalC]},{\[Gamma],\[Gamma]s}]] . \[Gamma]s]  ]


(* ::Input::Initialization:: *)
SuperStar[(\[ScriptCapitalE]_)]:=\[ScriptCapitalE]/.{\!\(\*OverscriptBox[\(\[Gamma]\), \(_\)]\)->\[Gamma],\[Gamma]->\!\(\*OverscriptBox[\(\[Gamma]\), \(_\)]\),\[Omega]->\[Omega]^-1,c_Complex:>c\[Conjugate]};
SuperPlus[r_Rule]:={r,SuperStar[r]}


(* ::Input::Initialization:: *)
RulesOf[Subscript[\[Gamma], i_]+rest_.]:=SuperPlus[(Subscript[\[Gamma], i]->-rest)];
CF[PQ[\[ScriptCapitalC]_,q_]]:=Module[{n\[ScriptCapitalC]=CF[\[ScriptCapitalC]]},
PQ[n\[ScriptCapitalC],CF[q/.Union@@RulesOf/@n\[ScriptCapitalC]]]  ]


(* ::Input::Initialization:: *)
CF[Subscript[\[CapitalSigma], b_][\[Sigma]_,pq_]]:=Subscript[\[CapitalSigma], CF[b]][\[Sigma],CF[pq]]


(* ::Input::Initialization:: *)
Format[Subscript[\[CapitalSigma], b_B][\[Sigma]_,PQ[\[ScriptCapitalC]_,q_]]]:=Module[{\[Gamma]s},
\[Gamma]s=Subscript[\[Gamma], #]&/@Join@@b;
Column[{TraditionalForm@\[Sigma],
TableForm[Join[
Prepend[""]/@Table[TraditionalForm[\!\(
\*SubscriptBox[\(\[PartialD]\), \(c\)]r\)],{r,\[ScriptCapitalC]},{c,\[Gamma]s}],
{Prepend[""][
Join@@(b/.{l_,m___,r_}:>{DisplayForm@RowBox[{"(",l}],m,DisplayForm@RowBox[{r,")"}]})/.i_Integer:>Subscript[\[Gamma], i] ]},
MapThread[Prepend,{Table[TraditionalForm[\!\(
\*SubscriptBox[\(\[PartialD]\), \(r, c\)]q\)],{r,SuperStar[\[Gamma]s]},{c,\[Gamma]s}],SuperStar[\[Gamma]s]}]
],TableAlignments->Center]
}, Center] ];


(* ::Input::Initialization:: *)
Subscript[\[CapitalSigma], b1_][\[Sigma]1_,PQ[\[ScriptCapitalC]1_,q1_]]\[CirclePlus]Subscript[\[CapitalSigma], b2_][\[Sigma]2_,PQ[\[ScriptCapitalC]2_,q2_]]^:=CF@Subscript[\[CapitalSigma], Join[b1,b2]][\[Sigma]1+\[Sigma]2,PQ[\[ScriptCapitalC]1\[Union]\[ScriptCapitalC]2,q1+q2]];


(* ::Input::Initialization:: *)
Subscript[GT, i_,j_]@Subscript[\[CapitalSigma], B[{li___,i_,ri___},{lj___,j_,rj___},bs___]][\[Sigma]_,PQ[\[ScriptCapitalC]_,q_]]:=CF@Subscript[\[CapitalSigma], B[{ri,li,j,rj,lj,i},bs]][\[Sigma],PQ[\[ScriptCapitalC]\[Union]{Subscript[\[Gamma], i]-Subscript[\[Gamma], j]},q]]


(* ::Input::Initialization:: *)
Subscript[Cordon, i_]@Subscript[\[CapitalSigma], B[{li___,i_,ri___},bs___]][\[Sigma]_,PQ[\[ScriptCapitalC]_,q_]]:=Module[{\[Phi]=\!\(
\*SubscriptBox[\(\[PartialD]\), 
SubscriptBox[\(\[Gamma]\), \(i\)]]\[ScriptCapitalC]\),\[Lambda]=\!\(
\*SubscriptBox[\(\[PartialD]\), \(
\*SubscriptBox[
OverscriptBox[\(\[Gamma]\), \(_\)], \(i\)], 
\*SubscriptBox[\(\[Gamma]\), \(i\)]\)]q\),n\[Sigma]=\[Sigma],n\[ScriptCapitalC],nq,p},
{p}=FirstPosition[(#=!=0)&/@\[Phi],True,{0}];
{n\[ScriptCapitalC],nq}=Which[
p>0, {\[ScriptCapitalC],q}/.SuperPlus[(Subscript[\[Gamma], i]->-\[ScriptCapitalC][[p]]/\[Phi][[p]])]/.SuperPlus[(Subscript[\[Gamma], i]->0)],
\[Lambda]=!=0,(n\[Sigma]+=sign[\[Lambda]];{\[ScriptCapitalC],q/.SuperPlus[(Subscript[\[Gamma], i]->-(\!\(
\*SubscriptBox[\(\[PartialD]\), 
SubscriptBox[
OverscriptBox[\(\[Gamma]\), \(_\)], \(i\)]]q\))/\[Lambda])]/.SuperPlus[(Subscript[\[Gamma], i]->0)]}),
\[Lambda]===0,{\[ScriptCapitalC]\[Union]{\!\(
\*SubscriptBox[\(\[PartialD]\), 
SubscriptBox[
OverscriptBox[\(\[Gamma]\), \(_\)], \(i\)]]q\)},q/.SuperPlus[(Subscript[\[Gamma], i]->0)]}];
CF@Subscript[\[CapitalSigma], B[Most@{ri,li},bs]][n\[Sigma],PQ[n\[ScriptCapitalC],nq]/.SuperPlus[(Subscript[\[Gamma], Last@{ri,li}]->Subscript[\[Gamma], First@{ri,li}])]]  ]


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


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


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


(* ::Input::Initialization:: *)
Kas@Subscript[P, i_,j_]:=CF@Subscript[\[CapitalSigma], B[{i,j}]][0,PQ[{},0]];
TL@Subscript[P, i_,j_]:=CF@Subscript[\[CapitalSigma], B[{i,j}]][0,PQ[{},0]]


(* ::Input::Initialization:: *)
Kas[x:X[i_,j_,k_,l_]]:=Kas@If[PositiveQ[x],Subscript[X, -i,j,k,-l],Subscript[\!\(\*OverscriptBox[\(X\), \(_\)]\), -j,k,l,-i]];
Kas[Subscript[(x:X|\!\(\*OverscriptBox[\(X\), \(_\)]\)), fs__]]:=Module[{v=2u^2-1,p,\[Gamma]s,m},
\[Gamma]s=Subscript[\[Gamma], #]&/@{fs};p=(x===X);
m=If[p,\!\(\*
TagBox[
RowBox[{"(", GridBox[{
{"v", "u", "1", "u"},
{"u", "1", "u", "1"},
{"1", "u", "v", "u"},
{"u", "1", "u", "1"}
},
GridBoxAlignment->{"Columns" -> {{Center}}, "Rows" -> {{Baseline}}},
GridBoxSpacings->{"Columns" -> {Offset[0.27999999999999997`], {Offset[0.7]}, Offset[0.27999999999999997`]}, "Rows" -> {Offset[0.2], {Offset[0.4]}, Offset[0.2]}}], ")"}],
Function[BoxForm`e$, MatrixForm[BoxForm`e$]]]\),\!\(\*
TagBox[
RowBox[{"-", 
RowBox[{"(", GridBox[{
{"v", "u", "1", "u"},
{"u", "1", "u", "1"},
{"1", "u", "v", "u"},
{"u", "1", "u", "1"}
},
GridBoxAlignment->{"Columns" -> {{Center}}, "Rows" -> {{Baseline}}},
GridBoxSpacings->{"Columns" -> {Offset[0.27999999999999997`], {Offset[0.7]}, Offset[0.27999999999999997`]}, "Rows" -> {Offset[0.2], {Offset[0.4]}, Offset[0.2]}}], ")"}]}],
Function[BoxForm`e$, MatrixForm[BoxForm`e$]]]\)];
CF@Subscript[\[CapitalSigma], B[{fs}]][If[p,-1,1],PQ[{},SuperStar[\[Gamma]s] . m . \[Gamma]s]]]


(* ::Input::Initialization:: *)
TL[x:X[i_,j_,k_,l_]]:=TL@If[PositiveQ[x],Subscript[X, -i,j,k,-l],Subscript[\!\(\*OverscriptBox[\(X\), \(_\)]\), -j,k,l,-i]];
TL[Subscript[(x:X|\!\(\*OverscriptBox[\(X\), \(_\)]\)), fs__]]:=Module[{t=1-\[Omega],r,\[Gamma]s,m},
r=t+SuperStar[t];\[Gamma]s=Subscript[\[Gamma], #]&/@{fs};
m=If[x===X,
\!\(\*
TagBox[
RowBox[{"(", "", GridBox[{
{
RowBox[{"-", "r"}], 
RowBox[{"-", "t"}], 
RowBox[{"2", "t"}], 
SuperscriptBox["t", "*"]},
{
RowBox[{"-", 
SuperscriptBox["t", "*"]}], "0", 
SuperscriptBox["t", "*"], "0"},
{
RowBox[{"2", 
SuperscriptBox["t", "*"]}], "t", 
RowBox[{"-", "r"}], 
RowBox[{"-", 
SuperscriptBox["t", "*"]}]},
{"t", "0", 
RowBox[{"-", "t"}], "0"}
},
GridBoxAlignment->{"Columns" -> {{Center}}, "Rows" -> {{Baseline}}},
GridBoxSpacings->{"Columns" -> {Offset[0.27999999999999997`], {Offset[0.7]}, Offset[0.27999999999999997`]}, "Rows" -> {Offset[0.2], {Offset[0.4]}, Offset[0.2]}}], "", ")"}],
Function[BoxForm`e$, MatrixForm[BoxForm`e$]]]\),\!\(\*
TagBox[
RowBox[{"(", "", GridBox[{
{"r", 
RowBox[{"-", "t"}], 
RowBox[{
RowBox[{"-", "2"}], 
SuperscriptBox["t", "*"]}], 
SuperscriptBox["t", "*"]},
{
RowBox[{"-", 
SuperscriptBox["t", "*"]}], "0", 
SuperscriptBox["t", "*"], "0"},
{
RowBox[{
RowBox[{"-", "2"}], "t"}], "t", "r", 
RowBox[{"-", 
SuperscriptBox["t", "*"]}]},
{"t", "0", 
RowBox[{"-", "t"}], "0"}
},
GridBoxAlignment->{"Columns" -> {{Center}}, "Rows" -> {{Baseline}}},
GridBoxSpacings->{"Columns" -> {Offset[0.27999999999999997`], {Offset[0.7]}, Offset[0.27999999999999997`]}, "Rows" -> {Offset[0.2], {Offset[0.4]}, Offset[0.2]}}], "", ")"}],
Function[BoxForm`e$, MatrixForm[BoxForm`e$]]]\)];
CF@Subscript[\[CapitalSigma], B[{fs}]][0,PQ[{},SuperStar[\[Gamma]s] . m . \[Gamma]s]]]


(* ::Input::Initialization:: *)
Kas[K_]:=Fold[mc[#1\[CirclePlus]#2]&,Subscript[\[CapitalSigma], B[]][0,PQ[{},0]],List@@(Kas/@PD@K)];
KasSig[K_]:=KasSig[K]=Expand[Kas[K][[1]]/2]


(* ::Input::Initialization:: *)
TL[K_]:=Fold[mc[#1\[CirclePlus]#2]&,Subscript[\[CapitalSigma], B[]][0,PQ[{},0]],List@@(TL/@PD@K)]/.\[Theta][c_+u]/;Abs[c]>=1:>\[Theta][c];
TLSig[K_]:=TLSig[K]=TL[K][[1]]



