(* ::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\\Projects\\HigherRank"];
Once[<<KnotTheory`; <<Rot.m];


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


(* ::Input::Initialization:: *)
\[DoubleStruckCapitalE]/:\[DoubleStruckCapitalE][A_]\[DoubleStruckCapitalE][B_]:=\[DoubleStruckCapitalE][A+B]


(* ::Input::Initialization:: *)
$\[Pi]=Identity;


(* ::Input::Initialization:: *)
Unprotect[Integrate];
Integrate::sing="How dare you ask me to integrate a singular Gaussian!";
\[Integral]\[Omega]_. \[DoubleStruckCapitalE][L_]\[DifferentialD](vs_List):=Module[{n,L0,Q,\[CapitalDelta],G,Z,e,\[Lambda],a,b},
n=Length@vs; L0=L/.\[Epsilon]->0;
Q=Table[(-\!\(
\*SubscriptBox[\(\[PartialD]\), \(vs[\([\)\(a\)\(]\)], vs[\([\)\(b\)\(]\)]\)]L0\))/.Thread[vs->0]/.Subscript[(p|x), __]->0,{a,n},{b,n}];
If[(\[CapitalDelta]=CF@Det[Q])==0,Message[Integrate::sing]; Return[]];
Z=CF@$\[Pi][L+vs . Q . vs/2]; G=Inverse[Q];
While[
e=CF@$\[Pi][(\!\(
\*SubscriptBox[\(\[PartialD]\), \(\[Lambda]\)]Z\))-1/2 \!\(
\*UnderoverscriptBox[\(\[Sum]\), \(a = 1\), \(n\)]\(
\*UnderoverscriptBox[\(\[Sum]\), \(b = 1\), \(n\)]G[\([\)\(a, b\)\(]\)] \((\((
\*SubscriptBox[\(\[PartialD]\), \(vs[\([\)\(a\)\(]\)], vs[\([\)\(b\)\(]\)]\)]Z)\) + \((
\*SubscriptBox[\(\[PartialD]\), \(vs[\([\)\(a\)\(]\)]\)]Z)\) \((
\*SubscriptBox[\(\[PartialD]\), \(vs[\([\)\(b\)\(]\)]\)]Z)\))\)\)\)];
0=!=e,Z-=\!\(
\*SubsuperscriptBox[\(\[Integral]\), \(0\), \(\[Lambda]\)]\(e\ \[DifferentialD]\[Lambda]\)\)
];
PowerExpand@Factor[\[Omega] (\[CapitalDelta] (2\[Pi])^n)^(-1/2)]\[DoubleStruckCapitalE][CF[Z/.\[Lambda]->1/.Thread[vs->0]]]
];
Protect[Integrate];


(* ::Input::Initialization:: *)
q[s_,i_,j_]:=Subscript[x, i]((1-T^s)Subscript[p, i+1]+(T^s-1)Subscript[p, j+1]);
Subscript[r, 1][s_,i_,j_]:=s (-1+2Subscript[p, i] Subscript[x, i]-2Subscript[p, j] Subscript[x, i]+(T^s-1)Subscript[p, i] Subscript[p, j] \!\(\*SubsuperscriptBox[\(x\), \(i\), \(2\)]\)+(1-T^s)\!\(\*SubsuperscriptBox[\(p\), \(j\), \(2\)]\) \!\(\*SubsuperscriptBox[\(x\), \(i\), \(2\)]\)-2Subscript[p, i] Subscript[p, j] Subscript[x, i] Subscript[x, j]+2\!\(\*SubsuperscriptBox[\(p\), \(j\), \(2\)]\) Subscript[x, i] Subscript[x, j])/2;
Subscript[\[Gamma], 1][\[CurlyPhi]_,k_]:=\[Epsilon] \[CurlyPhi](1/2-Subscript[x, k] Subscript[p, k]);
\[Rho]1i[s_,i_,j_]:=T^(s/2) \[DoubleStruckCapitalE][-q[s,i,j]+\[Epsilon] Subscript[r, 1][s,i,j]];
\[Rho]1i[\[CurlyPhi]_,k_]:=T^(\[CurlyPhi]/2) \[DoubleStruckCapitalE][-Subscript[x, k] (Subscript[p, k]-Subscript[p, k+1])+Subscript[\[Gamma], 1][\[CurlyPhi],k]];
\[Rho]1i[End,k_]:=\[DoubleStruckCapitalE][-Subscript[x, k] Subscript[p, k]];
\[Rho]1i[K_]:=Module[{Cs,\[CurlyPhi],n,c,k,\[ScriptCapitalE]},
{Cs,\[CurlyPhi]}=Rot[K]; n=Length[Cs];
\[ScriptCapitalE]=\[Rho]1i[End,2n+1];
Do[\[ScriptCapitalE]*=\[Rho]1i@@c,{c,Cs}];
Do[\[ScriptCapitalE]*=\[Rho]1i[\[CurlyPhi][[k]],k],{k,2n}];
CF@\[ScriptCapitalE]
];
\[Rho]1vs[K_] := Union@@Table[{Subscript[x, i],Subscript[p, i]},{i,2Crossings[K]+1}]



