(* ::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.                                                         *)
(************************************************************************)



SetDirectory["C:\\drorbn\\AcademicPensieve\\Projects\\WKO4"];


<< FreeLie.m;
<< AwCalculus.m;
$SeriesShowDegree=4;


x=LW@"x"; y=LW@"y";
{\[Alpha],\[Beta],\[Gamma]} = LS /@ {x+b[x,y], y-b[x,b[x,y]], x+y-2b[x,y]}


bch=BCH[x,y] 


{Subscript[\[Omega], 1],Subscript[\[Omega], 2]} = CWS /@ {cw[x]-3cw[y,x,x],  cw[y]+cw[y,y]}


{\[Lambda]=\[LeftAngleBracket]x->\[Alpha], y -> \[Beta]\[RightAngleBracket], \[Gamma] // Subscript[D, \[Lambda]]}


\[Lambda]1=\[Lambda]; \[Lambda]2=\[LeftAngleBracket]x->\[Beta], y -> \[Gamma]\[RightAngleBracket]; Rol1=tb[\[Lambda]1,\[Lambda]2]


u=LW@"u"; v=LW@"v";
With[{\[Gamma]=b[b[v,u],u]}, Subscript[tr, u][\[Gamma]]]


(* ::Input:: *)
x=LW@"x"; y=LW@"y";
{Subscript[\[Zeta], a]=El[\[LeftAngleBracket]x->LS[x+b[x,y]], y->LS[y-b[x,b[x,y]]]\[RightAngleBracket], CWS[cw[x]-3cw[x,y,x]]],
Subscript[\[Zeta], b]=El[\[LeftAngleBracket]x->LS[y-b[x,y]], y->LS[x+y+b[y,b[x,y]]]\[RightAngleBracket], CWS[cw[y]-2cw[x,y]]],
Subscript[\[Zeta], c]=El[\[LeftAngleBracket]x->LS[x-b[b[x,y],b[x,y]]], y->LS[y+3b[x,b[x,y]]]\[RightAngleBracket], CWS[cw[x]-2cw[x,y]+cw[x,y,x]]]}


{Subscript[\[Zeta], d]=El[\[Lambda], CWS[0]], Subscript[\[Zeta], d] // dA}


Subscript[\[Xi], a]=Es[\[LeftAngleBracket]1->LS[u+b[u,v]], 2->LS[v-b[u,b[u,v]]], 3->LS[u-b[b[u,v],b[u,v]]]\[RightAngleBracket], CWS[cw[u]-3cw[u,v,u]]]


Subscript[\[Xi], b]=RandomEsSeries[0, {1,2,3,4}];
Subscript[\[Xi], b]@{2}


(* ::Input:: *)
Rl[a_,b_]:= El[\[LeftAngleBracket]a->LS[0], b->LS[LW@a]\[RightAngleBracket], CWS[0]];
iRl[a_,b_]:= El[\[LeftAngleBracket]a->LS[0], b->-LS[LW@a]\[RightAngleBracket], CWS[0]];
Rs[a_,b_]:= Es[\[LeftAngleBracket]a->LS[0], b->LS[LW@a]\[RightAngleBracket], CWS[0]];
iRs[a_,b_]:= Es[\[LeftAngleBracket]a->LS[0], b->-LS[LW@a]\[RightAngleBracket], CWS[0]];


(* ::Input:: *)
x=LW["x"]; y=LW["y"]; z=LW["z"];
\[Alpha]=LS[{x,y}, \[Alpha]s]; \[Beta]=LS[{x,y}, \[Beta]s];\[Gamma]=CWS[{x,y}, \[Gamma]s];
Subscript[V, 0]=Es[\[LeftAngleBracket]x->\[Alpha], y->\[Beta]\[RightAngleBracket], \[Gamma]];


\[Kappa]=CWS[{x}, \[Kappa]s]; Cap=Es[\[LeftAngleBracket]x->LS[0]\[RightAngleBracket],\[Kappa]];


(* ::Input:: *)
R4Eqn=Subscript[V, 0]**(Rs[x,z] // d\[CapitalDelta][x,x,y]) \[Congruent] Rs[y,z]**Rs[x,z]**Subscript[V, 0] ;UnitarityEqn=Subscript[V, 0]**(Subscript[V, 0]//dA) \[Congruent] Es[\[LeftAngleBracket]x->LS[0], y->LS[0]\[RightAngleBracket],CWS[0]];
CapEqn=(Subscript[V, 0]**(Cap//d\[CapitalDelta][x,x,y])//dc[x]//dc[y]) \[Congruent] (Cap*(Cap//d\[Sigma][x,y])//dc[x]//dc[y]);


\[Beta]s["x"]= 1/2; \[Beta]s["y"]=0;
SeriesSolve[{\[Alpha], \[Beta],\[Gamma], \[Kappa]}, (\[HBar]^-1 R4Eqn) \[And] UnitarityEqn \[And] CapEqn];
{Subscript[V, 0]@{4}, \[Kappa]@{6}}


logF = \[CapitalLambda][Subscript[V, 0]][[1]]  // d\[Sigma][{x,y}->{y,x}]


atkv=logF // EulerE // adSeries[(E^ad-1)/ad, logF, tb];
{f=Subscript[atkv, x], g=Subscript[atkv, y]}


\[CapitalTheta]l[x_,y_, s_] := El[\[LeftAngleBracket]x->LS[s LW@y], y->LS[s LW@x]\[RightAngleBracket], CWS[0]];
\[CapitalTheta]s[x_,y_,s_] := \[CapitalTheta]l[x,y,s] // \[CapitalGamma];
{\[CapitalTheta]l[x,y,1], \[CapitalTheta]s[x,y,1]}


{A=LS[{x,y}, As], B=LS[{x,y}, Bs]};
msgs=SeriesSolve[{A,B},
\[HBar]^-1 (b[x, A]+b[y,B] \[Congruent] LS[0])\[And](Subscript[div, x][A]+Subscript[div, y][B]\[Congruent]CWS[0])];
{A,B}


\[CapitalPhi]s[2,1]=\[CapitalPhi]s[3,1]=\[CapitalPhi]s[3,2]=0;\[CapitalPhi]s[3,1,2]=1/24; Subscript[\[CapitalPhi], 0]=DKS[3, \[CapitalPhi]s];
SeriesSolve[Subscript[\[CapitalPhi], 0], (Subscript[\[CapitalPhi], 0]^\[Sigma][3,2,1]\[Congruent]-Subscript[\[CapitalPhi], 0])\[And](Subscript[\[CapitalPhi], 0]**Subscript[\[CapitalPhi], 0]^\[Sigma][1,23,4]**Subscript[\[CapitalPhi], 0]^\[Sigma][2,3,4]\[Congruent]Subscript[\[CapitalPhi], 0]^\[Sigma][12,3,4]**Subscript[\[CapitalPhi], 0]^\[Sigma][1,2,34])];
Subscript[\[CapitalPhi], 0]@{6}


(* ::Input:: *)
Subscript[V, 12]=Subscript[V, 0]//d\[Sigma][{x,y}->{1,2}];
Subscript[\[CapitalPhi], V] = (Subscript[V, 12]//dA)^\[Sigma][12,3]**(Subscript[V, 12]//dA)^\[Sigma][1,2]**Subscript[V, 12]^\[Sigma][2,3]**Subscript[V, 12]^\[Sigma][1,23]


DK2Es[s___][\[Zeta]_] := El[\[Zeta] // \[Alpha]Map[s], CWS[0]] // \[CapitalGamma];
DK2Es[1,2,3][Subscript[\[CapitalPhi], 0]]


(* ::Input:: *)
R = DKS[t[1,2]/2];
Subscript[Z, B] = (-Subscript[\[CapitalPhi], 0])^\[Sigma][13,2,4]**Subscript[\[CapitalPhi], 0]^\[Sigma][1,3,2]**R^\[Sigma][2,3]**(-Subscript[\[CapitalPhi], 0])^\[Sigma][1,2,3]**Subscript[\[CapitalPhi], 0]^\[Sigma][12,3,4]


\[Nu]inv=Subscript[\[CapitalPhi], 0] //DK2Es[1,2,3] // dS[2] // dm[3,2,2] // dm[2,1,x]


Subscript[\[Rho], 3][\[Zeta]_Es] := \[Zeta] // dS[y] // d\[CapitalDelta][y,y,z] // dm[x,z,x] // d\[Sigma][{x,y}->{y,x}];
Subscript[\[Xi], c]=RandomEsSeries[1, {x,y}];
Subscript[\[Xi], c]\[Congruent](Subscript[\[Xi], c]//Subscript[\[Rho], 3]//Subscript[\[Rho], 3]//Subscript[\[Rho], 3])



