(* ::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@Together[\[ScriptCapitalE]]; (*CoefficientCanonical Form *)
CF[\[ScriptCapitalE]_List]:=CF/@\[ScriptCapitalE];
CF[\[ScriptCapitalE]_\[Epsilon]Series]:=CF/@\[ScriptCapitalE];
CF[\[ScriptCapitalE]_] := Subscript[PP, CF]@Module[
{vs=Cases[\[ScriptCapitalE],Subscript[(y|x|\[Eta]|\[Xi]), _],\[Infinity]]\[Union]{y|x|\[Eta]|\[Xi]}},
Total[(CCF[#[[2]]](Times@@(vs^#[[1]])))& /@ CoefficientRules[Expand[\[ScriptCapitalE]], vs]]
];
(*CF[\[ScriptCapitalE]_] := Subscript[PP, CF]@CCF[\[ScriptCapitalE]];*)
CF[\[ScriptCapitalE]_\[DoubleStruckCapitalE]]:=CF/@\[ScriptCapitalE]; 
CF[Subscript[\[DoubleStruckCapitalE], sp___][\[ScriptCapitalE]s___]]:=CF/@Subscript[\[DoubleStruckCapitalE], sp][\[ScriptCapitalE]s];


(* ::Input::Initialization:: *)
\[Epsilon]Series/: S1_\[Epsilon]Series\[Congruent]S2_\[Epsilon]Series:=Length[S1]==Length[S2]\[And]Inner[CF[#1]==CF[#2]&,S1,S2,And];
\[Epsilon]Series[0]/;$k>0:=\[Epsilon]Series@@Table[0,$k+1];
\[Epsilon]Series/: S1_\[Epsilon]Series+S2_\[Epsilon]Series := \[Epsilon]Series@@Table[S1[[k]]+S2[[k]],{k,Min[Length@S1,Length@S2]}];
\[Epsilon]Series/: S1_\[Epsilon]Series*S2_\[Epsilon]Series := \[Epsilon]Series@@Table[Sum[S1[[j+1]]*S2[[k-j+1]], {j,0,k}],{k,0,Min[Length@S1,Length@S2]-1}];
\[Epsilon]Series /:c_*S_\[Epsilon]Series:=(c #)& /@ S;
\[Epsilon]Series/:\!\(
\*SubscriptBox[\(\[PartialD]\), \(vs___\)]S_\[Epsilon]Series\):=(s|->\!\(
\*SubscriptBox[\(\[PartialD]\), \(vs\)]s\))/@S;


(* ::Input::Initialization:: *)
{SuperStar[y],SuperStar[x],SuperStar[\[Eta]],SuperStar[\[Xi]]}={\[Eta],\[Xi],y,x}; 
SuperStar[(vs_List)]:=(v|->SuperStar[v])/@vs;
SuperStar[(Subscript[u_, i_])]:=Subscript[(SuperStar[u]), i];


(* ::Input::Initialization:: *)
\[DoubleStruckCapitalE]/:\[DoubleStruckCapitalE][\[Omega]1_,Q1_,P1_]\[Congruent]\[DoubleStruckCapitalE][\[Omega]2_,Q2_,P2_]:=CF[\[Omega]1==\[Omega]2]\[And]CF[Q1==Q2]\[And](P1\[Congruent]P2);
\[DoubleStruckCapitalE]/:\[DoubleStruckCapitalE][\[Omega]1_,Q1_,P1_]\[DoubleStruckCapitalE][\[Omega]2_,Q2_,P2_]:=\[DoubleStruckCapitalE][\[Omega]1 \[Omega]2,Q1+Q2,P1+P2];
Subscript[\[DoubleStruckCapitalE], d1_->r1_][\[ScriptCapitalE]1s___]\[Congruent]Subscript[\[DoubleStruckCapitalE], d2_->r2_][\[ScriptCapitalE]2s___] ^:= (d1==d2)\[And](r1==r2)\[And](\[DoubleStruckCapitalE][\[ScriptCapitalE]1s]\[Congruent]\[DoubleStruckCapitalE][\[ScriptCapitalE]2s]);
Subscript[\[DoubleStruckCapitalE], d1_->r1_][\[ScriptCapitalE]1s___]Subscript[\[DoubleStruckCapitalE], d2_->r2_][\[ScriptCapitalE]2s___] ^:= Subscript[\[DoubleStruckCapitalE], (d1\[Union]d2)->(r1\[Union]r2)]@@(\[DoubleStruckCapitalE][\[ScriptCapitalE]1s]\[DoubleStruckCapitalE][\[ScriptCapitalE]2s]);
Subscript[Subscript[\[DoubleStruckCapitalE], dr_][\[ScriptCapitalE]s___], $k_]:=Subscript[\[DoubleStruckCapitalE], dr]@@Subscript[\[DoubleStruckCapitalE][\[ScriptCapitalE]s], $k];


(* ::Input::Initialization:: *)
Subscript[\[DoubleStruckCapitalE], d1_->r1_][\[ScriptCapitalE]1s___]//Subscript[\[DoubleStruckCapitalE], d2_->r2_][\[ScriptCapitalE]2s___] :=Module[{is=r1\[Intersection]d2,lvs},
lvs=Flatten@Table[{Subscript[x, $@i],Subscript[y, $@i]},{i,is}];
Subscript[\[DoubleStruckCapitalE], (d1\[Union]Complement[d2,is])->(r2\[Union]Complement[r1,is])]@@(Subscript[Zip, lvs\[Union]SuperStar[lvs]][SuperStar[lvs] . lvs,Times[
\[DoubleStruckCapitalE][\[ScriptCapitalE]1s]/.Table[Subscript[(v:x|y), i]->Subscript[v, $@i],{i,is}],
\[DoubleStruckCapitalE][\[ScriptCapitalE]2s]/.Table[Subscript[(v:\[Xi]|\[Eta]), i]->Subscript[v, $@i],{i,is}]
]])
]


(* ::Input::Initialization:: *)
Subscript[Zip, vs_][\[ScriptCapitalF]_,\[ScriptCapitalE]_]:=\[LeftAngleBracket]\[ScriptCapitalF],\[ScriptCapitalE]\[RightAngleBracket]//Subscript[Zip1, vs]//Subscript[Zip2, vs]//Subscript[Zip3, vs];
Subscript[Zip, vs_][\[ScriptCapitalF]_,\[ScriptCapitalE]_]:=\[LeftAngleBracket]\[ScriptCapitalF],\[ScriptCapitalE]\[RightAngleBracket]//Subscript[Zip1, vs]//Subscript[EZip23, vs];


(* ::Input::Initialization:: *)
\!\(\*SubscriptBox[\(Zip1\), \({}\)]\)=Identity;
Subscript[Zip1, vs_]@\[LeftAngleBracket]\[ScriptCapitalF]_,\[DoubleStruckCapitalE][\[Omega]_,Q_,P_]\[RightAngleBracket] := Subscript[PP, Zip1]@Module[{\[ScriptCapitalI],F,G,u,v},
\[ScriptCapitalI]=IdentityMatrix@Length@vs;
F=Table[\!\(
\*SubscriptBox[\(\[PartialD]\), \(u, v\)]\[ScriptCapitalF]\),{u,SuperStar[vs]},{v,SuperStar[vs]}];
G=Table[\!\(
\*SubscriptBox[\(\[PartialD]\), \(u, v\)]Q\),{u,vs},{v,vs}];
\[LeftAngleBracket]CF[SuperStar[vs] . F . Inverse[\[ScriptCapitalI]-G . F] . SuperStar[vs]/2], \[DoubleStruckCapitalE][CF@PowerExpand@Factor[\[Omega]  Det[\[ScriptCapitalI]- G . F]^(-1/2)],CF[Q-vs . G . vs/2],P]\[RightAngleBracket]
]


(* ::Input::Initialization:: *)
\!\(\*SubscriptBox[\(Zip2\), \({}\)]\)=Identity;
Subscript[Zip2, vs_]@\[LeftAngleBracket]\[ScriptCapitalF]_,\[DoubleStruckCapitalE][\[Omega]_,Q_,P_]\[RightAngleBracket] := Subscript[PP, Zip2]@Module[{F,Y,u,v},
F=Table[\!\(
\*SubscriptBox[\(\[PartialD]\), \(u, v\)]\[ScriptCapitalF]\),{u,SuperStar[vs]},{v,SuperStar[vs]}];
Y=Table[\!\(
\*SubscriptBox[\(\[PartialD]\), \(v\)]Q\),{v,vs}];
CF/@\[LeftAngleBracket]\[ScriptCapitalF], \[DoubleStruckCapitalE][\[Omega],Q-Y . vs+Y . F . Y/2, P/.Thread[vs->vs+F . Y]]\[RightAngleBracket]
]


(* ::Input::Initialization:: *)
Subscript[Zip3, vs_]@\[LeftAngleBracket]\[ScriptCapitalF]_,\[DoubleStruckCapitalE][\[Omega]_,Q_,P_]\[RightAngleBracket] := Subscript[PP, Zip3]@Module[{Z,u,v,m,j},
Z[0]=P;
For[m=0,m<2$k,++m,
Z[m+1]=CF[1/(2(m+1)) Sum[\!\(
\*SubscriptBox[\(\[PartialD]\), \(
\*SuperscriptBox[\(u\), \(*\)], 
\*SuperscriptBox[\(v\), \(*\)]\)]\[ScriptCapitalF]\)(\!\(
\*SubscriptBox[\(\[PartialD]\), \(u, v\)]\(Z[m]\)\)+Sum[(\!\(
\*SubscriptBox[\(\[PartialD]\), \(u\)]\(Z[j]\)\))(\!\(
\*SubscriptBox[\(\[PartialD]\), \(v\)]\(Z[m - j]\)\)),{j,0,m}]),{u,vs},{v,vs}]]
];
\[DoubleStruckCapitalE][\[Omega],Q,CF[Sum[Z[m],{m,0,2$k}]/.Table[v->0,{v,vs}]]]
]


(* ::Input::Initialization:: *)
Subscript[EZip23, vs_]@\[LeftAngleBracket]\[ScriptCapitalF]_,\[DoubleStruckCapitalE][\[Omega]_,Q_,P_]\[RightAngleBracket] := Subscript[PP, EZip23]@Module[
{nP,n\[ScriptCapitalF],nQ,j=0,ps,c,t,rr={(*release rules*)}},
nP=Total[
CoefficientRules[#, vs] /. (ps_->c_) :> (AppendTo[rr,t[++j]->CF@c]; t[j](Times@@(vs^ps)))
]& /@ P;
nQ=Total[CoefficientRules[Q, vs] /. (ps_->c_) :> (AppendTo[rr,t[++j]->CF@c]; t[j](Times@@(vs^ps)))];
n\[ScriptCapitalF]=Total[CoefficientRules[\[ScriptCapitalF], SuperStar[vs]] /. (ps_->c_) :> (AppendTo[rr,t[++j]->CF@c]; t[j](Times@@((SuperStar[vs])^ps)))];
CF[Expand[\[LeftAngleBracket]n\[ScriptCapitalF],\[DoubleStruckCapitalE][\[Omega],nQ,nP]\[RightAngleBracket]//Subscript[Zip2, vs]//Subscript[Zip3, vs]]/.rr]
]
