(* ::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[\[ScriptCapitalE]_List]:=CF/@\[ScriptCapitalE];
CF[sd_SeriesData] := MapAt[CF,sd,3];
CF[\[ScriptCapitalE]_] := Module[{vs=Cases[\[ScriptCapitalE],Subscript[(x|p), __],\[Infinity]]\[Union]{x,p},ps,c},
Total[CoefficientRules[Expand[\[ScriptCapitalE]], vs] /. (ps_->c_) :> CCF[c](Times@@(vs^ps))] ];


(* ::Input::Initialization:: *)
Unprotect[Integrate];
\[Integral]\[Omega]_. \[DoubleStruckCapitalE][L_]\[DifferentialD](vs_List):=Module[{n,Q,G,V,s,t,k,a,b},
n=Length@vs;
Q=-Table[(\!\(
\*SubscriptBox[\(\[PartialD]\), \(vs[\([\)\(a\)\(]\)], vs[\([\)\(b\)\(]\)]\)]L\))/.Thread[vs->0],{a,n},{b,n}];
G=Inverse[Q]/2;
V=L+vs . Q . vs/2;
s=t=V;k=0;
While[0=!=t,
s+=1/(++k)! (t=CF@Sum[G[[a,b]]((\!\(
\*SubscriptBox[\(\[PartialD]\), \(vs[\([\)\(a\)\(]\)], vs[\([\)\(b\)\(]\)]\)]t\))+(\!\(
\*SubscriptBox[\(\[PartialD]\), \(vs[\([\)\(a\)\(]\)]\)]t\))(\!\(
\*SubscriptBox[\(\[PartialD]\), \(vs[\([\)\(b\)\(]\)]\)]t\))),{a,n},{b,n}])];
PowerExpand@Factor[\[Omega] (Det[Q](2\[Pi])^n)^(-1/2)]\[DoubleStruckCapitalE][CF@s/.Thread[vs->0]]
];
Protect[Integrate];


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


(* ::Input::Initialization:: *)
Unprotect[Integrate];
\[Integral]\[Omega]_. \[DoubleStruckCapitalE][L_SeriesData]\[DifferentialD](vs_List):=Module[{n,L0,Q,\[CapitalDelta],G,V,s,t,k,a,b},
n=Length@vs; L0=Normal@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,Return["How dare you ask me to integrate a singular Gaussian!"]];
Echo@MatrixForm@Q;
G=Inverse[Q]/2;
V=L+vs . Q . vs/2;
s=t=V;k=0;
While[0=!=Normal@t,
s+=1/(++k)! (t=CF@Sum[G[[a,b]]((\!\(
\*SubscriptBox[\(\[PartialD]\), \(vs[\([\)\(a\)\(]\)], vs[\([\)\(b\)\(]\)]\)]t\))+(\!\(
\*SubscriptBox[\(\[PartialD]\), \(vs[\([\)\(a\)\(]\)]\)]t\))(\!\(
\*SubscriptBox[\(\[PartialD]\), \(vs[\([\)\(b\)\(]\)]\)]t\))),{a,n},{b,n}])];
PowerExpand@Factor[\[Omega] (\[CapitalDelta] (2\[Pi])^n)^(-1/2)]\[DoubleStruckCapitalE][CF@s/.Thread[vs->0]]
];
Protect[Integrate];



