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


(* ::Input::Initialization:: *)
CCF[\[ScriptCapitalE]_] := ExpandDenominator@ExpandNumerator@Together[\[ScriptCapitalE]];
CCF[\[ScriptCapitalE]_] := Factor[\[ScriptCapitalE]];
CF[\[ScriptCapitalE]_List]:=CF/@\[ScriptCapitalE]; CF[\[ScriptCapitalE]_EPD]:=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))] ];
CF[eqp_EQP]:=CF/@eqp


(* ::Input::Initialization:: *)
EQP/:c_*EQP[Q_,P_]:=EQP[Q,CF[c P]];
EQP/:EQP[Q1_,P1_]EQP[Q2_,P2_]:=CF@EQP[Q1+Q2,P1+P2];


(* ::Input::Initialization:: *)
{SuperStar[p],SuperStar[x]}={\[Pi],\[Xi]};  SuperStar[(Subscript[z_, i__])]:=Subscript[(SuperStar[z]), i]; SuperStar[vs_List]:=(v|->SuperStar[v])/@vs;
\!\(\*SubscriptBox[\(Zip\), \({}\)]\)[\[ScriptCapitalE]_]:=\[ScriptCapitalE];
\!\(\*SubscriptBox[\(Zip\), \({z_, zs___}\)]\)[\[ScriptCapitalE]_] := (Collect[\[ScriptCapitalE]//\!\(\*SubscriptBox[\(Zip\), \({zs}\)]\),z] /. f_. z^d_.:>(D[f,{SuperStar[z],d}]))/.SuperStar[z]->0


(* ::Input::Initialization:: *)
FI[EQP[Q_,P_]]:=FI[EQP[Q,P],Union@Cases[Q,Subscript[p, _],\[Infinity]],Union@Cases[Q,Subscript[x, _],\[Infinity]]];
FI[EQP[Q_,P_],ps_List,xs_List]:=Module[{u,v},
A=Table[\!\(
\*SubscriptBox[\(\[PartialD]\), \(u, v\)]Q\),{u,ps},{v,xs}];
CF[Det[A]^-1 Series[Subscript[Zip, ps\[Union]xs][Normal[E^P]E^-SuperStar[xs] . Inverse[A] . SuperStar[ps]], {\[Epsilon],0,1}]
]]


(* ::Input::Initialization:: *)
SuperPlus[(SuperPlus[\[Alpha]_])]:=\!\(\*SuperscriptBox[\(\[Alpha]\), \("\<++\>"\)]\);    (* this is for cosmetic reasons only *)


(* ::Input::Initialization:: *)
Subscript[R, 0][s_,i_,j_]:=EQP[-Subscript[x, i] (Subscript[p, i]-T^s Subscript[p, SuperPlus[i]]+(T^s-1) Subscript[p, SuperPlus[j]])-Subscript[x, j] (Subscript[p, j]-Subscript[p, SuperPlus[j]]),0];
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;
Subscript[\[Gamma], 1][\[CurlyPhi]_,k_]:=\[CurlyPhi] (1/2-Subscript[p, k] Subscript[x, k]);
Subscript[R, 1][s_,i_,j_]:=EQP[-Subscript[x, i] (Subscript[p, i]-T^s Subscript[p, SuperPlus[i]]+(T^s-1) Subscript[p, SuperPlus[j]])-Subscript[x, j] (Subscript[p, j]-Subscript[p, SuperPlus[j]]), \[Epsilon] Subscript[r, 1][s,i,j]+O[\[Epsilon]]^2];


(* ::Input::Initialization:: *)
eqp1[K_]:=Module[{Cs,\[CurlyPhi],n,eqp,s,i,j,k,\[Alpha]},
{Cs,\[CurlyPhi]}=Rot[K]; n=Length[Cs];
eqp=EQP[-Subscript[x, 2n+1] Subscript[p, 2n+1],O[\[Epsilon]]^2];
Cases[Cs,{s_,i_,j_}:>(eqp*=Subscript[R, 1][s,i,j])];
Do[eqp*=EQP[0,\[Epsilon] Subscript[\[Gamma], 1][\[CurlyPhi][[k]],k]],{k,2n}];
CF[eqp/.SuperPlus[(\[Alpha]_)]:>\[Alpha]+1] ];



