(* ::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:: *)
CCF[\[ScriptCapitalE]_] := Subscript[PP, CCF]@ExpandDenominator@ExpandNumerator@Subscript[PP, Together]@Together[Subscript[PP, Exp][
Expand[\[ScriptCapitalE]] //. E^x_ E^y_:>E^(x+y) /. E^x_:>E^CCF[x]]];
CF[\[ScriptCapitalE]_List]:=CF/@\[ScriptCapitalE];
CF[sd_SeriesData] := MapAt[CF,sd,3];
CF[\[ScriptCapitalE]_] := Subscript[PP, CF]@Module[
{vs=Cases[\[ScriptCapitalE],Subscript[(y|b|t|a|x|\[Eta]|\[Beta]|\[Tau]|\[Alpha]|\[Xi]), _],\[Infinity]]\[Union]{y,b,t,a,x,\[Eta],\[Beta],\[Tau],\[Alpha],\[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:: *)
K\[Delta]/:Subscript[K\[Delta], i_,j_]:=If[i===j,1,0];


(* ::Input::Initialization:: *)
\[DoubleStruckCapitalE]/:\[DoubleStruckCapitalE][L1_,Q1_,P1_]\[Congruent]\[DoubleStruckCapitalE][L2_,Q2_,P2_]:=CF[L1==L2]\[And]CF[Q1==Q2]\[And]CF[Normal[P1-P2]==0];
\[DoubleStruckCapitalE]/:\[DoubleStruckCapitalE][L1_,Q1_,P1_]\[DoubleStruckCapitalE][L2_,Q2_,P2_]:=\[DoubleStruckCapitalE][L1+L2,Q1+Q2,P1*P2];
Subscript[\[DoubleStruckCapitalE][L_,Q_,P_], $k_]:=\[DoubleStruckCapitalE][L,Q,Series[Normal@P,{\[Epsilon],0,$k}]];


(* ::Input::Initialization:: *)
\[DoubleStruckCapitalE]3@\[DoubleStruckCapitalE][\[Omega]_,L_,Q_,Ps_]:=CF/@Subscript[\[DoubleStruckCapitalE][L,\[Omega]^-1 Q,\[Omega]^-1 (\[Omega]^-4 \[Epsilon])^(-1+Range@Length@Ps).Ps], $k];
\[DoubleStruckCapitalE]4@\[DoubleStruckCapitalE][L_,Q_,P_]:=Module[
{\[Omega]=Normal[P]^-1/.\[Epsilon]->0,Ps=CoefficientList[P,\[Epsilon]]},
CF/@\[DoubleStruckCapitalE][\[Omega],L,\[Omega] Q,\[Omega]^(-3+4Range@Length@Ps) Ps]];
\[DoubleStruckCapitalE]3@Subscript[\[DoubleStruckCapitalE], sp___][as___]:=\[DoubleStruckCapitalE]3@\[DoubleStruckCapitalE][as]/.\[DoubleStruckCapitalE]->Subscript[\[DoubleStruckCapitalE], sp];
\[DoubleStruckCapitalE]4@Subscript[\[DoubleStruckCapitalE], sp___][as___]:=\[DoubleStruckCapitalE]4@\[DoubleStruckCapitalE][as]/.\[DoubleStruckCapitalE]->Subscript[\[DoubleStruckCapitalE], sp];


(* ::Input::Initialization:: *)
{SuperStar[t],SuperStar[b],SuperStar[y],SuperStar[a],SuperStar[x],SuperStar[z]}={\[Tau],\[Beta],\[Eta],\[Alpha],\[Xi],\[Zeta]}; 
{SuperStar[\[Tau]],SuperStar[\[Beta]],SuperStar[\[Eta]],SuperStar[\[Alpha]],SuperStar[\[Xi]],SuperStar[\[Zeta]]}={t,b,y,a,x,z}; SuperStar[(Subscript[u_, i_])]:=Subscript[(SuperStar[u]), i];


(* ::Input::Initialization:: *)
collect[sd_SeriesData, \[Zeta]_] := MapAt[collect[#,\[Zeta]]&,sd,3];
collect[\[ScriptCapitalE]_,\[Zeta]_] := Subscript[PP, Collect]@Collect[\[ScriptCapitalE],\[Zeta]];
\!\(\*SubscriptBox[\(Zip\), \({}\)]\)[P_]:=P;
Subscript[Zip, \[Zeta]s_][Ps_List]:=Subscript[Zip, \[Zeta]s]/@Ps;
\!\(\*SubscriptBox[\(Zip\), \({\[Zeta]_, \[Zeta]s___}\)]\)[P_] := Subscript[PP, Zip][
(collect[P//\!\(\*SubscriptBox[\(Zip\), \({\[Zeta]s}\)]\),\[Zeta]] /. f_. \[Zeta]^d_.:>\!\(
\*SubscriptBox[\(\[PartialD]\), \({
\*SuperscriptBox[\(\[Zeta]\), \(*\)], d}\)]f\)) /. SuperStar[\[Zeta]]->0]


(* ::Input::Initialization:: *)
$QZipFail=False;
Subscript[QZip, \[Zeta]s_List]@\[DoubleStruckCapitalE][L_,Q_,P_] := Subscript[PP, QZip]@Module[{\[Zeta],z,zs,c,ys,\[Eta]s,qt,zrule,\[Zeta]rule,out},
zs=Table[SuperStar[\[Zeta]],{\[Zeta],\[Zeta]s}];
c=CF[Q/.Alternatives@@(\[Zeta]s\[Union]zs)->0];
ys=CF@Table[\!\(
\*SubscriptBox[\(\[PartialD]\), \(\[Zeta]\)]\((Q /. Alternatives @@ zs -> 0)\)\),{\[Zeta],\[Zeta]s}];
\[Eta]s=CF@Table[\!\(
\*SubscriptBox[\(\[PartialD]\), \(z\)]\((Q /. Alternatives @@ \[Zeta]s -> 0)\)\),{z,zs}];
qt=CF@Inverse@Table[Subscript[K\[Delta], z,SuperStar[\[Zeta]]]-\!\(
\*SubscriptBox[\(\[PartialD]\), \(z, \[Zeta]\)]Q\),{\[Zeta],\[Zeta]s},{z,zs}];
zrule=Thread[zs->CF[qt.(zs+ys)]];
\[Zeta]rule=Thread[\[Zeta]s->\[Zeta]s+\[Eta]s.qt];
out=CF /@ \[DoubleStruckCapitalE][L,c+\[Eta]s.qt.ys,Det[qt]Subscript[Zip, \[Zeta]s][P/.(zrule\[Union]\[Zeta]rule)]];
If[\[Not]($QZipFail\[Or]TrueQ[out\[Congruent]\[DoubleStruckCapitalE]3@Subscript[QZip, \[Zeta]s]@\[DoubleStruckCapitalE]4@\[DoubleStruckCapitalE][L,Q,P]]),
$QZipFail=True;Print["\!\(\*
StyleBox[\"QZip4\",\nFontColor->RGBColor[1, 0, 0]]\)\!\(\*
StyleBox[\" \",\nFontColor->RGBColor[1, 0, 0]]\)\!\(\*
StyleBox[\"fail\",\nFontColor->RGBColor[1, 0, 0]]\)\!\(\*
StyleBox[\" \",\nFontColor->RGBColor[1, 0, 0]]\)\!\(\*
StyleBox[\"at\",\nFontColor->RGBColor[1, 0, 0]]\) {L,Q,P}=", {L,Q,P}]
];
out
];


(* ::Input::Initialization:: *)
$QZipFail=False;
Subscript[QZip, \[Zeta]s_List]@\[DoubleStruckCapitalE][\[Omega]_,L_,Q_,Ps_] := Subscript[PP, QZip4]@Module[{\[Zeta],z,zs,c,ys,\[Eta]s,qt,zrule,\[Zeta]rule},
zs=Table[SuperStar[\[Zeta]],{\[Zeta],\[Zeta]s}];
c=CF[Q/.Alternatives@@(\[Zeta]s\[Union]zs)->0];
ys=CF@Table[\!\(
\*SubscriptBox[\(\[PartialD]\), \(\[Zeta]\)]\((Q /. Alternatives @@ zs -> 0)\)\),{\[Zeta],\[Zeta]s}];
\[Eta]s=CF@Table[\!\(
\*SubscriptBox[\(\[PartialD]\), \(z\)]\((Q /. Alternatives @@ \[Zeta]s -> 0)\)\),{z,zs}];
qt=CF@Inverse@Table[Subscript[K\[Delta], z,SuperStar[\[Zeta]]]-\!\(
\*SubscriptBox[\(\[PartialD]\), \(z, \[Zeta]\)]Q\),{\[Zeta],\[Zeta]s},{z,zs}];
zrule=Thread[zs->CF[qt.(zs+ys)]];
\[Zeta]rule=Thread[\[Zeta]s->\[Zeta]s+\[Eta]s.qt];
CF /@ \[DoubleStruckCapitalE][\[Omega] Det[qt/\[Omega]],L,c+\[Eta]s.qt.ys,Subscript[Zip, \[Zeta]s][Ps/.(zrule\[Union]\[Zeta]rule)]] ];


(* ::Input::Initialization:: *)
U2l={\!\(
\*SubsuperscriptBox[\(B\), \(i_\), \(p_.\)] -> 
\*SuperscriptBox[\(E\), \(\(-p\)\ \[HBar]\ \[Gamma]\ 
\*SubscriptBox[\(b\), \(i\)]\)]\),B^p_.->E^(-p \[HBar] \[Gamma] b), \!\(
\*SubsuperscriptBox[\(T\), \(i_\), \(p_.\)] -> 
\*SuperscriptBox[\(E\), \(p\ \[HBar]\ 
\*SubscriptBox[\(t\), \(i\)]\)]\),T^p_.->E^(p \[HBar] t),\!\(
\*SubsuperscriptBox[\(\[ScriptCapitalA]\), \(i_\), \(p_.\)] -> 
\*SuperscriptBox[\(E\), \(p\ \[Gamma]\ 
\*SubscriptBox[\(\[Alpha]\), \(i\)]\)]\),\[ScriptCapitalA]^p_.->E^(p \[Gamma] \[Alpha])}; 
l2U={E^(c_. Subscript[b, i_]+d_.):>\!\(
\*SubsuperscriptBox[\(B\), \(i\), \(\(-c\)/\((\[HBar]\ \[Gamma])\)\)] 
\*SuperscriptBox[\(E\), \(d\)]\),E^(c_. b+d_.):>B^(-c/(\[HBar] \[Gamma])) E^d,
E^(c_. Subscript[t, i_]+d_.):>\!\(
\*SubsuperscriptBox[\(T\), \(i\), \(c/\[HBar]\)] 
\*SuperscriptBox[\(E\), \(d\)]\),E^(c_. t+d_.):>T^(c/\[HBar]) E^d,
E^(c_. Subscript[\[Alpha], i_]+d_.):>\!\(
\*SubsuperscriptBox[\(\[ScriptCapitalA]\), \(i\), \(c/\[Gamma]\)] 
\*SuperscriptBox[\(E\), \(d\)]\),E^(c_. \[Alpha]+d_.):>\[ScriptCapitalA]^(c/\[Gamma]) E^d,
E^\[ScriptCapitalE]_:>E^Expand@\[ScriptCapitalE]};


(* ::Input::Initialization:: *)
Subscript[LZip, \[Zeta]s_List]@\[DoubleStruckCapitalE][L_,Q_,P_] := Subscript[PP, LZip]@Module[{\[Zeta],z,zs,c,ys,\[Eta]s,lt,zrule,Zrule,\[Zeta]rule,Q1,EEQ,EQ},
zs=Table[SuperStar[\[Zeta]],{\[Zeta],\[Zeta]s}];
c=L/.Alternatives@@(\[Zeta]s\[Union]zs)->0;
ys=Table[\!\(
\*SubscriptBox[\(\[PartialD]\), \(\[Zeta]\)]\((L /. Alternatives @@ zs -> 0)\)\),{\[Zeta],\[Zeta]s}];
\[Eta]s=Table[\!\(
\*SubscriptBox[\(\[PartialD]\), \(z\)]\((L /. Alternatives @@ \[Zeta]s -> 0)\)\),{z,zs}];
lt=Inverse@Table[Subscript[K\[Delta], z,SuperStar[\[Zeta]]]-\!\(
\*SubscriptBox[\(\[PartialD]\), \(z, \[Zeta]\)]L\),{\[Zeta],\[Zeta]s},{z,zs}];
zrule=Thread[zs->lt.(zs+ys)];
Zrule=zrule/.r_Rule:>((U=r[[1]]/.{b->B,t->T,\[Alpha]->\[ScriptCapitalA]})->(U/.U2l/.r//.l2U)); (* not used *)
\[Zeta]rule=Thread[\[Zeta]s->\[Zeta]s+\[Eta]s.lt];
Q1=Q/.U2l/.(zrule\[Union]\[Zeta]rule);
EEQ[ps___]:=EEQ[ps]=\!\(\*SubscriptBox[\(PP\), \("\<EEQ\>"\)]\)@(CF[E^-Q1 D[E^Q1,Sequence@@Thread[{zs,{ps}}]]]/.Alternatives@@zs->0//.l2U);
CF /@ ((*CF/@*)\[DoubleStruckCapitalE][
c+\[Eta]s.lt.ys,Q1/.Alternatives@@zs->0,
Det[lt](Subscript[Zip, \[Zeta]s][(EQ@@zs)(P/.U2l/.(zrule\[Union]\[Zeta]rule))] /. \!\(\*
TagBox[
StyleBox[
RowBox[{
RowBox[{
RowBox[{"Derivative", "[", "ps___", "]"}], "[", "EQ", "]"}], "[", "___", "]"}],
ShowSpecialCharacters->False,
ShowStringCharacters->True,
NumberMarks->True],
FullForm]\) :> EEQ[ps] /. _EQ->1)
]//.l2U)
 ];


(* ::Input::Initialization:: *)
\!\(\*SubscriptBox[\(B\), \({}\)]\)[L_,R_]:=L R;
\!\(\*SubscriptBox[\(B\), \({is__}\)]\)[L_\[DoubleStruckCapitalE],R_\[DoubleStruckCapitalE]] := Subscript[PP, B]@Module[{n},
Times[
L/.Table[Subscript[(v:b|B|t|T|a|x|y), i]->Subscript[v, n@i],{i,{is}}],
R/.Table[Subscript[(v:\[Beta]|\[Tau]|\[Alpha]|\[ScriptCapitalA]|\[Xi]|\[Eta]), i]->Subscript[v, n@i],{i,{is}}]
] // Subscript[LZip, Join@@Table[{Subscript[\[Beta], n@i],Subscript[\[Tau], n@i],Subscript[a, n@i]},{i,{is}}]] // Subscript[QZip, Join@@Table[{Subscript[\[Xi], n@i],Subscript[y, n@i]},{i,{is}}]] ];
Subscript[B, is___][L_,R_]:=\!\(\*SubscriptBox[\(B\), \({is}\)]\)[L,R];


(* ::Input::Initialization:: *)
Subscript[B, is_List][Subscript[\[DoubleStruckCapitalE], d1_->r1_][L1_,Q1_,P1_],Subscript[\[DoubleStruckCapitalE], d2_->r2_][L2_,Q2_,P2_]]:=Subscript[\[DoubleStruckCapitalE], (d1\[Union]Complement[d2,is])->(r2\[Union]Complement[r1,is])]@@Subscript[B, is][\[DoubleStruckCapitalE][L1,Q1,P1],\[DoubleStruckCapitalE][L2,Q2,P2]];
Subscript[\[DoubleStruckCapitalE], d1_->r1_][L1_,Q1_,P1_]//Subscript[\[DoubleStruckCapitalE], d2_->r2_][L2_,Q2_,P2_] := Subscript[B, r1\[Intersection]d2][Subscript[\[DoubleStruckCapitalE], d1->r1][L1,Q1,P1],Subscript[\[DoubleStruckCapitalE], d2->r2][L2,Q2,P2]];
Subscript[\[DoubleStruckCapitalE], d1_->r1_][L1_,Q1_,P1_]\[Congruent]Subscript[\[DoubleStruckCapitalE], d2_->r2_][L2_,Q2_,P2_] ^:= (d1==d2)\[And](r1==r2)\[And](\[DoubleStruckCapitalE][L1,Q1,P1]\[Congruent]\[DoubleStruckCapitalE][L2,Q2,P2]);
Subscript[\[DoubleStruckCapitalE], d1_->r1_][L1_,Q1_,P1_]Subscript[\[DoubleStruckCapitalE], d2_->r2_][L2_,Q2_,P2_] ^:= Subscript[\[DoubleStruckCapitalE], (d1\[Union]d2)->(r1\[Union]r2)]@@(\[DoubleStruckCapitalE][L1,Q1,P1]\[DoubleStruckCapitalE][L2,Q2,P2]);
Subscript[Subscript[\[DoubleStruckCapitalE], d_->r_][L_,Q_,P_], $k_]:=Subscript[\[DoubleStruckCapitalE], d->r]@@Subscript[\[DoubleStruckCapitalE][L,Q,P], $k];
Subscript[\[DoubleStruckCapitalE], _][\[ScriptCapitalE]___][i_]:={\[ScriptCapitalE]}[[i]];
