(* ::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:: *)
C\[CapitalLambda][t1_,y1_,a1_,x1_,\[Xi]1_,\[Eta]1_,\[Delta]_]:=Module[
{eqn,d,b,c,sol,\[Lambda],q,\[Nu], \[Xi], \[Eta]},
eqn=\[Rho][E^(\[Xi] Subscript[x, CU])].\[Rho][E^(\[Eta] Subscript[y, CU])]==\[Rho][E^(d Subscript[y, CU])].\[Rho][E^(c(t Subscript[1, CU] - 2\[Epsilon] Subscript[a, CU]))].\[Rho][E^(b Subscript[x, CU])];
sol=Solve[Thread[Flatten/@eqn], {d,b,c}][[1]] /. C[1]->0;
\[Lambda]=E^\!\(TraditionalForm\`\(-\[Eta]\)\ y - \[Xi]\ x + \[Eta]\ \[Xi]\ t\) Normal@Series[E^\!\(TraditionalForm\`c\ t\  + \ d\ y\  - \ 2  \[Epsilon]\ c\ a\  + \ b\ x\)/.sol,{\[Epsilon],0,$k}];
q=\!\(TraditionalForm\`
\*SuperscriptBox[\(E\), \(\[Nu] \((\(-t\)\ \[Xi]\ \[Eta] + \[Eta]\ y + \[Xi]\ x + \[Delta]\ y\ x)\)\)]\);
Collect[\[Nu] q^-1 Subscript[DP, \[Xi]->Subscript[D, x],\[Eta]->Subscript[D, y]][\[Lambda]][q] /. \[Nu]->(1+t \[Delta])^-1,\[Epsilon],Simplify] /. {t->t1,y->y1,a->a1,x->x1,\[Xi]->\[Xi]1, \[Eta]->\[Eta]1} ];


(* ::Input::Initialization:: *)
Q\[CapitalLambda][T1_,y1_,a1_,x1_,\[Xi]1_,\[Eta]1_,\[Delta]_]:=Module[
{G,F,fs,f,bs,e,b,es,\[Lambda],q,\[Nu], \[Xi], \[Eta],t},
G=Simp[Table[\[Xi]^k/k!, {k,0, $k+1}].NestList[Simp[Subscript[x, QU] ** # - #** Subscript[x, QU]]&, Subscript[y, QU], $k+1]];
fs=Flatten@Table[Subscript[f, l,i,j,k][\[Eta]],{l,0,$k},{i,0, l},{j,0, l},{k,0, l}];
F=fs.(bs=fs/.Subscript[f, l_,i_,j_,k_][\[Eta]]:>\[Epsilon]^l QU@{y^i,a^j,x^k});
es=Flatten[Table[Coefficient[e,b]==0,{e,{F-Subscript[1, QU]/.\[Eta]->0,F**G-Subscript[y, QU]**F-\!\(
\*SubscriptBox[\(\[PartialD]\), \(\[Eta]\)]F\)}},{b,bs}]];
{\[Lambda]}=F/.DSolve[es,fs,\[Eta]]/.{E^_->1,QU->Times};
q=\!\(TraditionalForm\`
\*SuperscriptBox[\(E\), \(\[Nu] \((\(-t\)\ \[Xi]\ \[Eta] + \[Eta]\ y + \[Xi]\ x + \[Delta]\ y\ x)\)\)]\);
Collect[\[Nu] q^-1 Subscript[DP, \[Xi]->Subscript[D, x],\[Eta]->Subscript[D, y]][\[Lambda]][q] /. \[Nu]->(1+t \[Delta])^-1/.t->(T-1)/\[HBar],\[Epsilon],Simplify] /. {T->T1,y->y1,a->a1,x->x1,\[Xi]->\[Xi]1, \[Eta]->\[Eta]1} ];


(* ::Input::Initialization:: *)
wc[CU]=t; wc[QU]=(T-1)/\[HBar];
\[CapitalLambda][U_] := \[CapitalLambda][U] = Module[{Q,w}, Q=(-w \[Xi] \[Eta]+\[Eta] y+\[Xi] x+\[Delta] y x)/(1+w \[Delta]);
Collect[(1+w \[Delta])^-1 E^-Q Subscript[DP, \[Xi]->Subscript[D, x],\[Eta]->Subscript[D, y]][\[Lambda][U]][E^Q]/. w->wc[U],\[Epsilon],Simplify]];
\[CapitalLambda][U_,t1_,T1_,y1_,a1_,x1_,\[Xi]1_,\[Eta]1_,\[Delta]1_] := \[CapitalLambda][U]/.{t->t1,T->T1,y->y1,a->a1,x->x1,\[Xi]->\[Xi]1,\[Eta]->\[Eta]1,\[Delta]->\[Delta]1};


(* ::Input::Initialization:: *)
Subscript[\[CapitalLambda], U_][{\[Upsilon]1_,\[Omega]1_,\[Delta]_},{u_,w_}] := Simp@Module[{\[Upsilon],\[Omega],yax,q,p,Q,uu,ww,d},
{yax,q,p}=List@@Subscript[\[CapitalLambda], U][{\[Upsilon],\[Omega]},{u,w}];
Subscript[\[CapitalOE], U][yax,Q=(\[Upsilon] uu+\[Omega] ww+\[Delta] uu ww+d \[Upsilon] \[Omega])/(1-d \[Delta]),Expand[(1-d \[Delta])^-1 E^-Q \!\(\*SubscriptBox[\(SP\), \({\[Upsilon] \[Rule] uu, \[Omega] \[Rule] ww}\)]\)[p E^Q]]] /. {d->\!\(
\*SubscriptBox[\(\[PartialD]\), \(\[Upsilon], \[Omega]\)]q\)}/.{\[Upsilon]->\[Upsilon]1,\[Omega]->\[Omega]1,uu->u,ww->w}];


(* ::Input::Initialization:: *)
SxF[0]=1;
SxF[k_] := SxF[k]=Module[{fs,bs,F,rhs,at0,at\[Xi]},
fs=Flatten@Table[Subscript[f, i,j][\[Xi]],{i,0, 2k},{j,0,2k-i}];
F=SxF[k-1]+\[Epsilon]^k fs.(bs=fs/.Subscript[f, i_,j_][\[Xi]]:>a^i x^j);
rhs=Normal@Last@Cord[Subscript[\[CapitalOE], QU][Subscript[{Subscript[a, 1],Subscript[x, 1],Subscript[a, 2],Subscript[x, 2]}, 1],-\[Xi] Subscript[x, 1],(F/.{a->Subscript[a, 1],x->Subscript[x, 1]})Series[-Subscript[x, 2] E^(\[HBar] \[Epsilon] Subscript[a, 2]),{\[Epsilon],0,k}]] /. \[Xi]->\[HBar] \[Xi]] /. {\[Xi]->\[HBar]^-1 \[Xi],Subscript[a, 1]->a,Subscript[x, 1]->x};
at0=(#==0)& /@ Flatten@CoefficientList[F-1 /. \[Xi]->0, {a,x}];
at\[Xi]=(#==0)& /@ Flatten@CoefficientList[(\!\(
\*SubscriptBox[\(\[PartialD]\), \(\[Xi]\)]F\))-x F-rhs, {a,x}];
F/.DSolve[And@@(at0\[Union]at\[Xi]),fs,\[Xi]][[1]]
];


(* ::Input::Initialization:: *)
SyF[0]=1;
SyF[k_]:= SyF[k]=Module[{fs,bs,F,rhs,at0,at\[Eta]},
fs=Flatten@Table[Subscript[f, i,j][\[Eta]],{i,0, 2k},{j,0,2k-i}];
F=SyF[k-1]+\[Epsilon]^k fs.(bs=fs/.Subscript[f, i_,j_][\[Eta]]:>y^i a^j);
rhs=Normal@Last@Cord[Subscript[\[CapitalOE], QU][Subscript[{Subscript[y, 1],Subscript[a, 1],Subscript[a, 2],Subscript[y, 2]}, 1],-T^-1\[Eta] Subscript[y, 1],(F/.{a->Subscript[a, 1],y->Subscript[y, 1]})Series[-Subscript[y, 2] T^-1 E^(\[HBar] \[Epsilon] Subscript[a, 2]),{\[Epsilon],0,k}]] /. \[Eta]->\[HBar] \[Eta]] /. {\[Eta]->\[HBar]^-1 \[Eta],Subscript[a, 1]->a,Subscript[y, 1]->y};
at0=(#==0)& /@ Flatten@CoefficientList[F-1 /. \[Eta]->0, {a,y}];
at\[Eta]=(#==0)& /@ Flatten@CoefficientList[(\!\(
\*SubscriptBox[\(\[PartialD]\), \(\[Eta]\)]F\))-T^-1 y F-rhs, {a,y}];
F/.DSolve[And@@(at0\[Union]at\[Eta]),fs,\[Eta]][[1]]
];


(* ::Input::Initialization:: *)

Subscript[\[CapitalLambda], U_,0][{\[Xi]1_,\[Eta]1_},{x,y}] := Subscript[\[CapitalOE], QU][{y,a,x},\[Xi] x+\[Eta] y+(U/. {CU->-t \[Eta] \[Xi], QU-> \[Eta] \[Xi] (1-T)/\[HBar]}),1+Subscript[0, 0]];
Subscript[\[CapitalLambda], U_,kk_][{\[Xi]1_,\[Eta]1_},{x,y}]:=(*Subscript[\[CapitalLambda], U,kk][{\[Xi]1,\[Eta]1},{x,y}]=*)Block[{$k=kk,$p=kk},Module[{\[Xi],\[Eta],G,F,fs,f,bs,e,b,es},
G=Simp[Table[\[Xi]^k/k!, {k,0, $k+1}].NestList[Simp[B[Subscript[x, U] ,# ]]&, Subscript[y, U], $k+1]];
fs=Flatten@Table[Subscript[f, i,j,k][\[Eta]],{i,0, $k},{j,0, $k},{k,0, $k}];
F=Subscript[\[DoubleStruckCapitalO], U][{y,a,x},Normal@Last@Subscript[\[CapitalLambda], U,kk-1][{\[Xi],\[Eta]},{x,y}]]+fs.(bs=fs/.Subscript[f, i_,j_,k_][\[Eta]]:>\[Epsilon]^kk U@{y^i,a^j,x^k});
es=Flatten[Table[Coefficient[e,b]==0,{e,{F-Subscript[1, U]/.\[Eta]->0,F**G-Subscript[y, U]**F-\!\(
\*SubscriptBox[\(\[PartialD]\), \(\[Eta]\)]F\)}},{b,bs}]];
F=F/.DSolve[es,fs,\[Eta]][[1]];
Subscript[\[CapitalOE], U][{y,a,x},
\[Xi] x+\[Eta] y+(U /. {CU->-t \[Eta] \[Xi], QU-> \[Eta] \[Xi] (1-T)/\[HBar]}),
Simplify[F+Subscript[0, $k]/.{E^_->1,U->Times}]
] /. {\[Xi]->\[Xi]1,\[Eta]->\[Eta]1}]];



