(* ::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\\2015-11"];
Get["../Projects/WKO4/FreeLie.m"];
Get["../Projects/WKO4/AwCalculus.m"];


x=LW["x"]; y=LW["y"]; z=LW["z"];
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]];
\[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];
R4Eqn[V_] := V**(Rs[x,z] // d\[CapitalDelta][x,x,y]) \[Congruent] Rs[y,z]**Rs[x,z]**V;
UnitarityEqn[V_] := V**(V//dA) \[Congruent] Es[\[LeftAngleBracket]x->LS[0], y->LS[0]\[RightAngleBracket],CWS[0]];
CapEqn[V_,Cap_] := (V**(Cap//d\[CapitalDelta][x,x,y])//dc[x]//dc[y]) \[Congruent] (Cap*(Cap//d\[Sigma][x,y])//dc[x]//dc[y]);


\[Kappa]s[xs___] := \[Kappa]s[xs] = SeriesCoefficient[1/4 Log[(\[HBar]/2)/Sinh[\[HBar]/2]], {\[HBar],0,Length@{xs}}];
\[Kappa]=CWS[{x}, \[Kappa]s];
Subscript[Cap, 0]=Es[\[LeftAngleBracket]x->LS[0]\[RightAngleBracket],\[Kappa]];
\[Kappa]@{16}


SymmetryFactor[l_List] := Module[{ll=l, sf=1},
While[(ll=RotateLeft[ll]) =!= l, ++sf];
sf];
SymmetryFactor[{1,1,1,2,1,1,1,2}]


\[Gamma]s[xs___] := \[Gamma]s[xs]= If[{xs}===RotateLeft@{xs}, 0, SymmetryFactor[{xs}]]*\[Kappa]s[xs];
\[Gamma]=CWS[{x,y}, \[Gamma]s];
\[Gamma]@{6}


\[Beta]s[t_]["x"]:= t; \[Beta]s[t_]["y"]:=0;
\[Alpha][t_] := \[Alpha][t]=LS[{x,y}, \[Alpha]s[t]]; \[Beta][t_] := \[Beta][t]=LS[{x,y}, \[Beta]s[t]];
V[t_] := (
V[t] = Es[\[LeftAngleBracket]x->\[Alpha][t], y->\[Beta][t]\[RightAngleBracket], \[Gamma]];
SeriesSolve[{\[Alpha][t], \[Beta][t]}, (\[HBar]^-1 R4Eqn[V[t]]) \[And] UnitarityEqn[V[t]] \[And] CapEqn[V[t],Subscript[Cap, 0]]];
V[t]
);
V[1/2]@{6}


\[Tau][V_]=Rs[x,y]**(V//d\[Sigma][{x,y}->{y,x}])**\[CapitalTheta]s[x,y,-1/2];
(V[#]\[Congruent]\[Tau][V[#]])@{6}& /@ {1/4,1/3,1/2,1}



