(* ::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\\Classes\\21-1350-KnotTheory"];
Once[<<"Common.m"];


$k=1;


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


(* ::Input::Initialization:: *)
\[Epsilon]Series/: S1_\[Epsilon]Series\[Congruent]S2_\[Epsilon]Series:=Length[S1]==Length[S2]\[And]Inner[CF[#1]==CF[#2]&,S1,S2,And];
\[Epsilon]Series[0]:=\[Epsilon]Series@@Table[0,$k+1];
\[Epsilon]Series/: S1_\[Epsilon]Series+S2_\[Epsilon]Series := \[Epsilon]Series@@Table[S1[[k]]+S2[[k]],{k,Min[Length@S1,Length@S2]}];
\[Epsilon]Series/: S1_\[Epsilon]Series*S2_\[Epsilon]Series := \[Epsilon]Series@@Table[Sum[S1[[j+1]]*S2[[k-j+1]], {j,0,k}],{k,0,Min[Length@S1,Length@S2]-1}];
\[Epsilon]Series /:c_*S_\[Epsilon]Series:=(c #)& /@ S;
\[Epsilon]Series/:\!\(
\*SubscriptBox[\(\[PartialD]\), \(vs___\)]S_\[Epsilon]Series\):=(s|->\!\(
\*SubscriptBox[\(\[PartialD]\), \(vs\)]s\))/@S;


(* ::Input::Initialization:: *)
{SuperStar[p],SuperStar[x],SuperStar[\[Pi]],SuperStar[\[Xi]]}={\[Pi],\[Xi],p,x}; 
SuperStar[(vs_List)]:=(v|->SuperStar[v])/@vs;
SuperStar[(Subscript[u_, i_])]:=Subscript[(SuperStar[u]), i];


(* ::Input::Initialization:: *)
\[DoubleStruckCapitalE]/:\[DoubleStruckCapitalE][\[Omega]1_,Q1_,P1_]\[Congruent]\[DoubleStruckCapitalE][\[Omega]2_,Q2_,P2_]:=CF[\[Omega]1==\[Omega]2]\[And]CF[Q1==Q2]\[And](P1\[Congruent]P2);
\[DoubleStruckCapitalE]/:\[DoubleStruckCapitalE][\[Omega]1_,Q1_,P1_]\[DoubleStruckCapitalE][\[Omega]2_,Q2_,P2_]:=\[DoubleStruckCapitalE][\[Omega]1 \[Omega]2,Q1+Q2,P1+P2];
Subscript[\[DoubleStruckCapitalE], d1_->r1_][\[ScriptCapitalE]1s___]\[Congruent]Subscript[\[DoubleStruckCapitalE], d2_->r2_][\[ScriptCapitalE]2s___] ^:= (d1==d2)\[And](r1==r2)\[And](\[DoubleStruckCapitalE][\[ScriptCapitalE]1s]\[Congruent]\[DoubleStruckCapitalE][\[ScriptCapitalE]2s]);
Subscript[\[DoubleStruckCapitalE], d1_->r1_][\[ScriptCapitalE]1s___]Subscript[\[DoubleStruckCapitalE], d2_->r2_][\[ScriptCapitalE]2s___] ^:= Subscript[\[DoubleStruckCapitalE], (d1\[Union]d2)->(r1\[Union]r2)]@@(\[DoubleStruckCapitalE][\[ScriptCapitalE]1s]\[DoubleStruckCapitalE][\[ScriptCapitalE]2s]);


(* ::Input::Initialization:: *)
Subscript[\[DoubleStruckCapitalE], d1_->r1_][\[ScriptCapitalE]1s___]//Subscript[\[DoubleStruckCapitalE], d2_->r2_][\[ScriptCapitalE]2s___] :=Module[{is=r1\[Intersection]d2,lvs},
lvs=Flatten@Table[{Subscript[x, $@i],Subscript[p, $@i]},{i,is}];
Subscript[\[DoubleStruckCapitalE], (d1\[Union]Complement[d2,is])->(r2\[Union]Complement[r1,is])]@@(Subscript[Zip, lvs\[Union]SuperStar[lvs]][SuperStar[lvs] . lvs,Times[
\[DoubleStruckCapitalE][\[ScriptCapitalE]1s]/.Table[Subscript[(v:x|p), i]->Subscript[v, $@i],{i,is}],
\[DoubleStruckCapitalE][\[ScriptCapitalE]2s]/.Table[Subscript[(v:\[Xi]|\[Pi]), i]->Subscript[v, $@i],{i,is}]
]])
]


(* ::Input::Initialization:: *)
Subscript[Zip, vs_][\[ScriptCapitalF]_,\[ScriptCapitalE]_]:=\[LeftAngleBracket]\[ScriptCapitalF],\[ScriptCapitalE]\[RightAngleBracket]//Subscript[Zip1, vs]//Subscript[Zip2, vs]//Subscript[Zip3, vs]


(* ::Input::Initialization:: *)
\!\(\*SubscriptBox[\(Zip1\), \({}\)]\)=Identity;
Subscript[Zip1, vs_]@\[LeftAngleBracket]\[ScriptCapitalF]_,\[DoubleStruckCapitalE][\[Omega]_,Q_,P_]\[RightAngleBracket] := Module[{\[ScriptCapitalI],F,G,u,v},
\[ScriptCapitalI]=IdentityMatrix@Length@vs;
F=Table[\!\(
\*SubscriptBox[\(\[PartialD]\), \(u, v\)]\[ScriptCapitalF]\),{u,SuperStar[vs]},{v,SuperStar[vs]}];
G=Table[\!\(
\*SubscriptBox[\(\[PartialD]\), \(u, v\)]Q\),{u,vs},{v,vs}];
CF/@\[LeftAngleBracket]SuperStar[vs] . F . Inverse[\[ScriptCapitalI]-G . F] . SuperStar[vs]/2, \[DoubleStruckCapitalE][PowerExpand@Factor[\[Omega]  Det[\[ScriptCapitalI]- G . F]^(-1/2)],Q-vs . G . vs/2,P]\[RightAngleBracket]
]


(* ::Input::Initialization:: *)
\!\(\*SubscriptBox[\(Zip2\), \({}\)]\)=Identity;
Subscript[Zip2, vs_]@\[LeftAngleBracket]\[ScriptCapitalF]_,\[DoubleStruckCapitalE][\[Omega]_,Q_,P_]\[RightAngleBracket] := Module[{F,Y,u,v},
F=Table[\!\(
\*SubscriptBox[\(\[PartialD]\), \(u, v\)]\[ScriptCapitalF]\),{u,SuperStar[vs]},{v,SuperStar[vs]}];
Y=Table[\!\(
\*SubscriptBox[\(\[PartialD]\), \(v\)]Q\),{v,vs}];
CF/@\[LeftAngleBracket]\[ScriptCapitalF], \[DoubleStruckCapitalE][\[Omega],Q-Y . vs+Y . F . Y/2, P/.Thread[vs->vs+F . Y]]\[RightAngleBracket]
]


(* ::Input::Initialization:: *)
Subscript[Zip3, vs_]@\[LeftAngleBracket]\[ScriptCapitalF]_,\[DoubleStruckCapitalE][\[Omega]_,Q_,P_]\[RightAngleBracket] := Module[{Z,u,v,m,j},
Z[0]=P;
For[m=0,m<2$k,++m,
Z[m+1]=CF[1/(2(m+1)) Sum[\!\(
\*SubscriptBox[\(\[PartialD]\), \(
\*SuperscriptBox[\(u\), \(*\)], 
\*SuperscriptBox[\(v\), \(*\)]\)]\[ScriptCapitalF]\)(\!\(
\*SubscriptBox[\(\[PartialD]\), \(u, v\)]\(Z[m]\)\)+Sum[(\!\(
\*SubscriptBox[\(\[PartialD]\), \(u\)]\(Z[j]\)\))(\!\(
\*SubscriptBox[\(\[PartialD]\), \(v\)]\(Z[m - j]\)\)),{j,0,m}]),{u,vs},{v,vs}]]
];
\[DoubleStruckCapitalE][\[Omega],Q,CF[Sum[Z[m],{m,0,2$k}]/.Table[v->0,{v,vs}]]]
]


(* ::Input::Initialization:: *)
Subscript[\[Eta], i_]:=\!\(\*SubscriptBox[\(\[DoubleStruckCapitalE]\), \({} \[Rule] {i}\)]\)[1,0,\[Epsilon]Series[0]];
Subscript[m, i_,j_->k_]:=\!\(\*SubscriptBox[\(\[DoubleStruckCapitalE]\), \({i, j} \[Rule] {k}\)]\)[1,-Subscript[\[Xi], i] Subscript[\[Pi], j]+(Subscript[\[Pi], i]+Subscript[\[Pi], j])Subscript[p, k]+(Subscript[\[Xi], i]+Subscript[\[Xi], j])Subscript[x, k],\[Epsilon]Series[0]]


(* ::Input::Initialization:: *)
AllMonomials[{},0]={1};
AllMonomials[{},d_Integer] /; d>0 := {};
AllMonomials[{v_,vs___},d_Integer] := Join@@Table[v^(d-k) AllMonomials[{vs},k],{k,0,d}];
AllMonomials[vs_List, {d_}] := Join@@Table[AllMonomials[vs,k],{k,0,d}];


(* ::Input::Initialization:: *)
Basis[js_List,m_]:=Flatten@Outer[Times,AllMonomials[Table[Subscript[p, j],{j,js}],m],AllMonomials[Table[Subscript[x, j],{j,js}],m]];
Basis[js_List,{m_}]:=Flatten@Table[Basis[js,k],{k,0,m}]


(* ::Input::Initialization:: *)
GenericCombination[bas_,c_]:=bas . Table[Subscript[c, j],{j,Length@bas}];
GenericCombination[bas_,Subscript[c_, k_]]:=bas . Table[Subscript[c, k,j],{j,Length@bas}];


(* ::Input::Initialization:: *)
Subscript[R, i_,j_]:=\!\(\*SubscriptBox[\(\[DoubleStruckCapitalE]\), \({} \[Rule] {i, j}\)]\)[T^(1/2),(T-1)(Subscript[p, i]-Subscript[p, j]) Subscript[x, j] ,\[Epsilon]Series@@Prepend[0]@Table[GenericCombination[Basis[{i,j},{k+1}],Subscript[c, k]],{k,$k}]];
Subscript[\!\(\*OverscriptBox[\(R\), \(_\)]\), i_,j_]:=\!\(\*SubscriptBox[\(\[DoubleStruckCapitalE]\), \({} \[Rule] {i, j}\)]\)[T^(-1/2),(T^-1-1)(Subscript[p, i]-Subscript[p, j]) Subscript[x, j],\[Epsilon]Series@@Prepend[0]@Table[GenericCombination[Basis[{i,j},{k+1}],Subscript[d, k]],{k,$k}]];
Subscript[C, i_]:=\!\(\*SubscriptBox[\(\[DoubleStruckCapitalE]\), \({} \[Rule] {i}\)]\)[T^(1/2),0,\[Epsilon]Series@@Prepend[0]@Table[GenericCombination[Basis[{i},{k+1}],Subscript[e, k]],{k,$k}]];
Subscript[\!\(\*OverscriptBox[\(C\), \(_\)]\), i_]:=\!\(\*SubscriptBox[\(\[DoubleStruckCapitalE]\), \({} \[Rule] {i}\)]\)[T^(-1/2),0,\[Epsilon]Series@@Prepend[0]@Table[GenericCombination[Basis[{i},{k+1}],Subscript[f, k]],{k,$k}]];


(* ::Input::Initialization:: *)
RMoves:={
(Subscript[R, 1,2] Subscript[R, 4,3] Subscript[R, 5,6]//Subscript[m, 1,4->1]//Subscript[m, 2,5->2]//Subscript[m, 3,6->3])\[Congruent](Subscript[R, 2,3] Subscript[R, 4,5] Subscript[R, 1,6]//Subscript[m, 1,4->1]//Subscript[m, 2,5->2]//Subscript[m, 3,6->3]),
(Subscript[R, 1,2] Subscript[\!\(\*OverscriptBox[\(R\), \(_\)]\), 3,4]//Subscript[m, 1,3->1]//Subscript[m, 2,4->2])\[Congruent](Subscript[\[Eta], 1] Subscript[\[Eta], 2]),
(Subscript[C, 1] Subscript[\!\(\*OverscriptBox[\(C\), \(_\)]\), 2]//Subscript[m, 1,2->1] )\[Congruent]Subscript[\[Eta], 1],
(Subscript[R, 1,4] Subscript[\!\(\*OverscriptBox[\(R\), \(_\)]\), 5,2] Subscript[\!\(\*OverscriptBox[\(C\), \(_\)]\), 3]//Subscript[m, 2,4->2]//Subscript[m, 1,3->1]//Subscript[m, 1,5->1])\[Congruent]Subscript[\!\(\*OverscriptBox[\(C\), \(_\)]\), 1] Subscript[\[Eta], 2],
(Subscript[C, 3] Subscript[R, 1,2]//Subscript[m, 2,3->2]//Subscript[m, 2,1->1])\[Congruent](Subscript[\!\(\*OverscriptBox[\(C\), \(_\)]\), 3] Subscript[R, 1,2]//Subscript[m, 1,3->1]//Subscript[m, 1,2->1]),
(Subscript[\!\(\*OverscriptBox[\(C\), \(_\)]\), 2] Subscript[R, 1,3]//Subscript[m, 1,2->1]//Subscript[m, 1,3->1])\[Congruent]Subscript[\[Eta], 1], (Subscript[\!\(\*OverscriptBox[\(C\), \(_\)]\), 2] Subscript[\!\(\*OverscriptBox[\(R\), \(_\)]\), 3,1]//Subscript[m, 1,2->1]//Subscript[m, 1,3->1])\[Congruent]Subscript[\[Eta], 1],
(Subscript[C, 2] Subscript[\!\(\*OverscriptBox[\(R\), \(_\)]\), 1,3]//Subscript[m, 1,2->1]//Subscript[m, 1,3->1])\[Congruent]Subscript[\[Eta], 1],(Subscript[C, 2] Subscript[R, 3,1]//Subscript[m, 1,2->1]//Subscript[m, 1,3->1])\[Congruent]Subscript[\[Eta], 1]
}



