(* ::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\\Talks\\Groningen-240530"];
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[\[ScriptCapitalE]_] := Module[{vs=Cases[\[ScriptCapitalE],Subscript[(x|p|\[Pi]), __],\[Infinity]]\[Union]{x,p,\[Epsilon]},ps,c},
Total[CoefficientRules[Expand[\[ScriptCapitalE]], vs] /. (ps_->c_) :> CCF[c](Times@@(vs^ps))] ];


(* ::Input::Initialization:: *)
\[ScriptCapitalS]={x,Subscript[x, _],y,z};
Subscript[q, x_,y_][f_]:=(\!\(
\*SubscriptBox[\(\[PartialD]\), \(x, y\)]f\))/.Thread[\[ScriptCapitalS]->0];
Subscript[\[Theta], x_,y_]:=x y;
f_\[Congruent]0:=f===0;
Subscript[Ev, vs_List->0][f_]:=CF[f/.Thread[vs->0]]


(* ::Input::Initialization:: *)
\[ScriptCapitalS]={x,y,z,\[Phi],Subscript[x, _],Subscript[p, _],Subscript[\!\(\*UnderscriptBox[\(x\), \(_\)]\), _],Subscript[\!\(\*UnderscriptBox[\(p\), \(_\)]\), _]};Subscript[q, x_,y_][ser_\[Epsilon]Series]:=(\!\(
\*SubscriptBox[\(\[PartialD]\), \(x, y\)]\(ser[\([\)\(1\)\(]\)]\)\))/.Thread[\[ScriptCapitalS]->0];
Subscript[\[Theta], x_,y_]:=x y;
\[Epsilon]Series/:D[ser_\[Epsilon]Series,vs___]:=D[#,vs]&/@ser;
\[Epsilon]Series/:Plus[ss___\[Epsilon]Series]/;Length[{ss}]>1:=Module[{l=Min[Length/@{ss}]},
\[Epsilon]Series@@Total[Take[List@@#,l]&/@{ss}]]
\[Epsilon]Series/:t_+ser_\[Epsilon]Series:=MapAt[(#+t)&,ser,1];
\[Epsilon]Series/:s1_\[Epsilon]Series*s2_\[Epsilon]Series:=\[Epsilon]Series@@Table[Sum[s1[[ii+1]]s2[[kk-ii+1]],{ii,0,kk}],{kk,0,Min[Length@s1,Length@s2]-1}];
\[Epsilon]Series/:c_*ser_\[Epsilon]Series:=(c #)&/@ser;
ser_\[Epsilon]Series \[Congruent] 0 := And@@((#===0)&/@ser);
\[Epsilon]Series/:Integrate[ser_\[Epsilon]Series,pars__]:=\[Epsilon]Series@@(Integrate[#,pars]&/@ser);
\[Epsilon]Series/:Subscript[Ev, vs_List->0][ser_\[Epsilon]Series]:=ser/.Thread[vs->0];
CF[ser_\[Epsilon]Series]:=CF/@ser;


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


(* ::Input::Initialization:: *)
\[DoubleStruckCapitalE][sd_SeriesData]/;(List@@sd)[[{1,2,4,6}]]==={\[Epsilon],0,0,1}:=\[DoubleStruckCapitalE][\[Epsilon]Series@@PadRight[sd[[3]],sd[[5]],0]]


(* ::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,Q,\[CapitalDelta],G,a,b,m,m1,$m},Clear[Z];
n=Length@vs;
Q=Table[Subscript[q, vs[[a]],vs[[b]]][L],{a,n},{b,n}];
If[(\[CapitalDelta]=CF@Det[-Q])==0,Message[Integrate::sing]; Return[]];
G=CF[-Inverse[Q]/2];Z[]=Z[0]=CF[L-Sum[Q[[a,b]]Subscript[\[Theta], vs[[a]],vs[[b]]],{a,n},{b,n}]/2];
Z[m_,a_]:=Z[m,a]=CF@D[Z[m],vs[[a]]];
Z[m_,a_,b_]/;a<=b:=Z[m,a,b]=CF@D[Z[m,a],vs[[b]]];
Z[m_,a_,b_]/;a>b:=Z[m,b,a];
For[$m=m=0,m<=2$m,++m,
Z[m+1]=CF@Sum[Sum[If[G[[a,b]]===0,0,
G[[a,b]]/(m+1) (Z[m,a,b]+Sum[Z[m1,a]Z[m-m1,b],{m1,0,m}])],
{a,n}],{b,n}];
If[!(Z[m+1]\[Congruent]0),$m=m+1;Z[]+=Z[m+1]];
];
PowerExpand@Factor[\[Omega] \[CapitalDelta]^(-1/2)]\[DoubleStruckCapitalE][CF[Subscript[Ev, vs->0][Z[]]]]
];
Protect[Integrate];


(* ::Input::Initialization:: *)
\[ScriptCapitalS]={Subscript[x, _],Subscript[p, _]};
q[s_,i_,j_]:=Subscript[x, i] (Subscript[p, i+1]-Subscript[p, i])+Subscript[x, j] (Subscript[p, j+1]-Subscript[p, j])+(T^s-1)Subscript[x, i](Subscript[p, i+1]-Subscript[p, j+1]);
Subscript[r, 1][s_,i_,j_]:=s/2 (Subscript[x, i](Subscript[p, i]-Subscript[p, j])((T^s-1)Subscript[x, i] Subscript[p, j]+2(1-Subscript[p, j] Subscript[x, j]))-1);
Subscript[r, 2][1,i_,j_]:=(-6 Subscript[p, i] Subscript[x, i]+6 Subscript[p, j] Subscript[x, i]-3 (-1+3 T) Subscript[p, i] Subscript[p, j] \!\(\*SubsuperscriptBox[\(x\), \(i\), \(2\)]\)+3 (-1+3 T) \!\(\*SubsuperscriptBox[\(p\), \(j\), \(2\)]\) \!\(\*SubsuperscriptBox[\(x\), \(i\), \(2\)]\)+4 (-1+T) \!\(\*SubsuperscriptBox[\(p\), \(i\), \(2\)]\) Subscript[p, j] \!\(\*SubsuperscriptBox[\(x\), \(i\), \(3\)]\)-2 (-1+T) (5+T) Subscript[p, i] \!\(\*SubsuperscriptBox[\(p\), \(j\), \(2\)]\) \!\(\*SubsuperscriptBox[\(x\), \(i\), \(3\)]\)+2 (-1+T) (3+T) \!\(\*SubsuperscriptBox[\(p\), \(j\), \(3\)]\) \!\(\*SubsuperscriptBox[\(x\), \(i\), \(3\)]\)+18 Subscript[p, i] Subscript[p, j] Subscript[x, i] Subscript[x, j]-18 \!\(\*SubsuperscriptBox[\(p\), \(j\), \(2\)]\) Subscript[x, i] Subscript[x, j]-6 \!\(\*SubsuperscriptBox[\(p\), \(i\), \(2\)]\) Subscript[p, j] \!\(\*SubsuperscriptBox[\(x\), \(i\), \(2\)]\) Subscript[x, j]+6 (2+T) Subscript[p, i] \!\(\*SubsuperscriptBox[\(p\), \(j\), \(2\)]\) \!\(\*SubsuperscriptBox[\(x\), \(i\), \(2\)]\) Subscript[x, j]-6 (1+T) \!\(\*SubsuperscriptBox[\(p\), \(j\), \(3\)]\) \!\(\*SubsuperscriptBox[\(x\), \(i\), \(2\)]\) Subscript[x, j]-6 Subscript[p, i] \!\(\*SubsuperscriptBox[\(p\), \(j\), \(2\)]\) Subscript[x, i] \!\(\*SubsuperscriptBox[\(x\), \(j\), \(2\)]\)+6 \!\(\*SubsuperscriptBox[\(p\), \(j\), \(3\)]\) Subscript[x, i] \!\(\*SubsuperscriptBox[\(x\), \(j\), \(2\)]\))/12;
Subscript[r, 2][-1,i_,j_]:=(-6 T^2 Subscript[p, i] Subscript[x, i]+6 T^2 Subscript[p, j] Subscript[x, i]+3 (-3+T) T Subscript[p, i] Subscript[p, j] \!\(\*SubsuperscriptBox[\(x\), \(i\), \(2\)]\)-3 (-3+T) T \!\(\*SubsuperscriptBox[\(p\), \(j\), \(2\)]\) \!\(\*SubsuperscriptBox[\(x\), \(i\), \(2\)]\)-4 (-1+T) T \!\(\*SubsuperscriptBox[\(p\), \(i\), \(2\)]\) Subscript[p, j] \!\(\*SubsuperscriptBox[\(x\), \(i\), \(3\)]\)+2 (-1+T) (1+5 T) Subscript[p, i] \!\(\*SubsuperscriptBox[\(p\), \(j\), \(2\)]\) \!\(\*SubsuperscriptBox[\(x\), \(i\), \(3\)]\)-2 (-1+T) (1+3 T) \!\(\*SubsuperscriptBox[\(p\), \(j\), \(3\)]\) \!\(\*SubsuperscriptBox[\(x\), \(i\), \(3\)]\)+18 T^2 Subscript[p, i] Subscript[p, j] Subscript[x, i] Subscript[x, j]-18 T^2 \!\(\*SubsuperscriptBox[\(p\), \(j\), \(2\)]\) Subscript[x, i] Subscript[x, j]-6 T^2 \!\(\*SubsuperscriptBox[\(p\), \(i\), \(2\)]\) Subscript[p, j] \!\(\*SubsuperscriptBox[\(x\), \(i\), \(2\)]\) Subscript[x, j]+6 T (1+2 T) Subscript[p, i] \!\(\*SubsuperscriptBox[\(p\), \(j\), \(2\)]\) \!\(\*SubsuperscriptBox[\(x\), \(i\), \(2\)]\) Subscript[x, j]-6 T (1+T) \!\(\*SubsuperscriptBox[\(p\), \(j\), \(3\)]\) \!\(\*SubsuperscriptBox[\(x\), \(i\), \(2\)]\) Subscript[x, j]-6 T^2 Subscript[p, i] \!\(\*SubsuperscriptBox[\(p\), \(j\), \(2\)]\) Subscript[x, i] \!\(\*SubsuperscriptBox[\(x\), \(j\), \(2\)]\)+6 T^2 \!\(\*SubsuperscriptBox[\(p\), \(j\), \(3\)]\) Subscript[x, i] \!\(\*SubsuperscriptBox[\(x\), \(j\), \(2\)]\))/(12T^2);
Subscript[\[Gamma], 1][\[CurlyPhi]_,k_]:=\[CurlyPhi](1/2-Subscript[x, k] Subscript[p, k]);
Subscript[\[Gamma], 2][\[CurlyPhi]_,k_]:=-\[CurlyPhi]^2 Subscript[p, k]Subscript[x, k]/2;
\[ScriptCapitalL][Subscript[X, i_,j_][s_]]:=T^(s/2) \[DoubleStruckCapitalE][q[s,i,j]+\[Epsilon] Subscript[r, 1][s,i,j]+\[Epsilon]^2 Subscript[r, 2][s,i,j]+O[\[Epsilon]]^3];
\[ScriptCapitalL][Subscript[C, k_][\[CurlyPhi]_]]:=T^(\[CurlyPhi]/2) \[DoubleStruckCapitalE][-Subscript[x, k](Subscript[p, k]-Subscript[p, k+1])+\[Epsilon] Subscript[\[Gamma], 1][\[CurlyPhi],k]+\[Epsilon]^2 Subscript[\[Gamma], 2][\[CurlyPhi],k]+O[\[Epsilon]]^3];
\[ScriptCapitalL][K_]:=(2\[Pi])^-Features[K][[1]] CF[\[ScriptCapitalL]/@Features[K][[2]]];
vs[K_] := Union@@Table[{Subscript[p, i],Subscript[x, i]},{i,Features[K][[1]]}]



