(* ::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:: *)
SetDirectory["C:\\drorbn\\AcademicPensieve\\People\\Kuno"];
<<FreeLie.m
<<AwCalculus.m
<< FAA.m


(* ::Input::Initialization:: *)
Subscript[Basis, d_][Subscript[\[DoubleStruckCapitalO], AR,ps_,ss_]]:=Subscript[PP, EMBasis][Subscript[\[DoubleStruckCapitalO], AR,ps,ss]/@Flatten[{
Subscript[\[ScriptCapitalA], 0]/@Subscript[Basis, d,ps][Product[Subscript[AW, s],{s,ss}]],
Table[Subscript[\[ScriptCapitalA], c[ss[[i]]]]/@(Subscript[Basis, d-1,ps][Product[Subscript[AW, s],{s,ss}]Subscript[AW, \!\(\*OverscriptBox[\(ss\[LeftDoubleBracket]i\[RightDoubleBracket]\), \(_\)]\)]]Subscript[AW, \!\(\*OverscriptBox[\(ss\[LeftDoubleBracket]i\[RightDoubleBracket]\), \(~\)]\)][]),{i,Length[ss]}],
Table[Subscript[\[ScriptCapitalA], c[ss[[i]],ss[[j]]]]/@(Subscript[Basis, d-1,ps][Product[Subscript[AW, s],{s,ss}]Subscript[AW, \!\(\*OverscriptBox[\(ss\[LeftDoubleBracket]i\[RightDoubleBracket]\), \(_\)]\)]]Subscript[AW, \!\(\*OverscriptBox[\(ss\[LeftDoubleBracket]j\[RightDoubleBracket]\), \(_\)]\)][]),{i,Length[ss]-1},{j,i+1,Length@ss}]
}]]


(* ::Input::Initialization:: *)
Subscript[Basis, d_][Subscript[\[DoubleStruckCapitalO], HR,ps_,ss_]]:=Subscript[PP, EMBasis][Subscript[\[DoubleStruckCapitalO], HR,ps,ss]/@Flatten[{
Subscript[\[ScriptCapitalA], 0]/@Subscript[Basis, d,ps][Product[Subscript[AW, s],{s,ss}]],
Table[Subscript[\[ScriptCapitalA], c[ss[[i]]]]/@(Subscript[Basis, d-1,ps][Product[Subscript[AW, s],{s,ss}]Subscript[CW, \!\(\*OverscriptBox[\(ss\[LeftDoubleBracket]i\[RightDoubleBracket]\), \(_\)]\)]]Subscript[AW, \!\(\*OverscriptBox[\(ss\[LeftDoubleBracket]i\[RightDoubleBracket]\), \(~\)]\)][]),{i,Length[ss]}],
Table[Subscript[\[ScriptCapitalA], c[ss[[i]],ss[[j]]]]/@(Subscript[Basis, d-1,ps][Product[Subscript[AW, s],{s,ss}]]Subscript[AW, \!\(\*OverscriptBox[\(ss\[LeftDoubleBracket]i\[RightDoubleBracket]\), \(_\)]\)][]Subscript[AW, \!\(\*OverscriptBox[\(ss\[LeftDoubleBracket]j\[RightDoubleBracket]\), \(_\)]\)][]),{i,Length[ss]-1},{j,i+1,Length@ss}]
}]]


(* ::Input::Initialization:: *)
Subscript[\[ScriptCapitalA], a_][A1_]+Subscript[\[ScriptCapitalA], a_][A2_]^:=Subscript[\[ScriptCapitalA], a][A1+A2];
c_*Subscript[\[ScriptCapitalA], a_][A_]/;FreeQ[c,\[ScriptCapitalA]]^:=Subscript[\[ScriptCapitalA], a][Expand[c A]];
Subscript[\[ScriptCapitalA], _][0]=0;


(* ::Input::Initialization:: *)
Subscript[\[DoubleStruckCapitalO], red_,ps_,ss_][x_]+Subscript[\[DoubleStruckCapitalO], red_,ps_,ss_][y_]^:=Subscript[\[DoubleStruckCapitalO], red,ps,ss][x+y];
c_*Subscript[\[DoubleStruckCapitalO], red_,ps_,ss_][x_]^:=Subscript[\[DoubleStruckCapitalO], red,ps,ss][Expand[c x]];
Subscript[\[DoubleStruckCapitalO], __][0]=0;


(* ::Input::Initialization:: *)
CF[Subscript[\[DoubleStruckCapitalO], red_,ps_,ss_][x_Plus]]:=Subscript[PP, EMCF][Subscript[\[DoubleStruckCapitalO], red,ps,ss][red/@x]];
CF[Subscript[\[DoubleStruckCapitalO], red_,ps_,ss_][x_]]:=Subscript[PP, EMCF][Subscript[\[DoubleStruckCapitalO], red,ps,ss][red@x]]


(* ::Input::Initialization:: *)
AR[0]=0;
AR[Subscript[\[ScriptCapitalA], 0][A_]]:=Subscript[\[ScriptCapitalA], 0][A];
AR[Subscript[\[ScriptCapitalA], c[s_]][A_]]:=Subscript[PP, EMAR]@Module[{l,r},Subscript[\[ScriptCapitalA], c[s]][A//Subscript[\[CapitalDelta], \!\(\*OverscriptBox[\(s\), \(~\)]\)->l,r]//Subscript[m, \!\(\*OverscriptBox[\(s\), \(_\)]\),l->\!\(\*OverscriptBox[\(s\), \(_\)]\)]//Subscript[\[CapitalDelta], r->l,r]//Subscript[m, s,r->s]//Subscript[S, l->l]//Subscript[m, l,\!\(\*OverscriptBox[\(s\), \(_\)]\)->\!\(\*OverscriptBox[\(s\), \(_\)]\)]//Subscript[\[Eta], \!\(\*OverscriptBox[\(s\), \(~\)]\)]]];
AR[Subscript[\[ScriptCapitalA], c[s1_,s2_]][A_]]:=Subscript[PP, EMAR]@Module[{l,r},Subscript[\[ScriptCapitalA], c[s1,s2]][A//Subscript[\[CapitalDelta], \!\(\*OverscriptBox[\(s2\), \(_\)]\)->l,r]//Subscript[m, s2,r->s2]//Subscript[\[CapitalDelta], l->l,r]//Subscript[m, s1,r->s1]//Subscript[S, l->l]//Subscript[m, l,\!\(\*OverscriptBox[\(s1\), \(_\)]\)->\!\(\*OverscriptBox[\(s1\), \(_\)]\)]//Subscript[\[Eta], \!\(\*OverscriptBox[\(s2\), \(_\)]\)]]];


(* ::Input::Initialization:: *)
HR[0]=0;
HR[Subscript[\[ScriptCapitalA], 0][A_]]:=Subscript[\[ScriptCapitalA], 0][A];
HR[Subscript[\[ScriptCapitalA], c[s_]][A_]]:=Subscript[PP, EMHR]@Module[{l,r},Subscript[\[ScriptCapitalA], c[s]][A//Subscript[m, \!\(\*OverscriptBox[\(s\), \(~\)]\),s->s]//Subscript[tr, \!\(\*OverscriptBox[\(s\), \(_\)]\)->\!\(\*OverscriptBox[\(s\), \(_\)]\)]//Subscript[\[Eta], \!\(\*OverscriptBox[\(s\), \(~\)]\)]]];
HR[Subscript[\[ScriptCapitalA], c[s1_,s2_]][A_]]:=Subscript[PP, EMHR]@Subscript[\[ScriptCapitalA], c[s1,s2]][A//Subscript[m, s1,\!\(\*OverscriptBox[\(s2\), \(_\)]\)->s1]//Subscript[m, s2,\!\(\*OverscriptBox[\(s1\), \(_\)]\)->s2]//Subscript[\[Eta], \!\(\*OverscriptBox[\(s1\), \(_\)]\)]//Subscript[\[Eta], \!\(\*OverscriptBox[\(s2\), \(_\)]\)]];


(* ::Input::Initialization:: *)
Subscript[\[DoubleStruckCapitalO], ss_][Subscript[\[DoubleStruckCapitalO], red_,ps_,s0s_][y_]]/;FreeQ[y,Subscript[\[ScriptCapitalA], 0]]:= Subscript[PP, \[DoubleStruckCapitalO]]@CF@Module[{s1,s2},
Subscript[\[DoubleStruckCapitalO], red,ps,ss][
y/.Subscript[\[ScriptCapitalA], c[s1_,s2_]][A1_]/;Position[ss,s1][[1,1]]>Position[ss,s2][[1,1]]:>red[Subscript[\[ScriptCapitalA], c[s2,s1]][A1]]
]];
Subscript[\[DoubleStruckCapitalO], ss_][Subscript[\[DoubleStruckCapitalO], red_,ps_,s0s_][Subscript[\[ScriptCapitalA], 0][A_]+y_.]]:= Subscript[PP, \[DoubleStruckCapitalO]]@CF@Module[{i,j,s1,s2,u1,u2},
Subscript[\[DoubleStruckCapitalO], red,ps,ss][Plus[
Subscript[\[ScriptCapitalA], 0][A],
y/.Subscript[\[ScriptCapitalA], c[s1_,s2_]][A1_]/;Position[ss,s1][[1,1]]>Position[ss,s2][[1,1]]:>red[Subscript[\[ScriptCapitalA], c[s2,s1]][A1]],
Sum[
If[Position[s0s,s1=ss[[i]]][[1,1]]<Position[s0s,s2=ss[[j]]][[1,1]],0,
Sum[
red[Subscript[\[ScriptCapitalA], c[s1,s2]][Expand[A(Subscript[AW, u1][p]Subscript[AW, u2][]-Subscript[AW, u1][]Subscript[AW, u2][p])]//Subscript[\[DoubleStruckCapitalD][p], s1->s1,\!\(\*OverscriptBox[\(s1\), \(_\)]\)]//Subscript[\[DoubleStruckCapitalD][p], s2->s2,\!\(\*OverscriptBox[\(s2\), \(_\)]\)]//Subscript[m, s1,u1->s1]//Subscript[m, u2,\!\(\*OverscriptBox[\(s1\), \(_\)]\)->\!\(\*OverscriptBox[\(s1\), \(_\)]\)]]],
{p,ps}
]
],
{i,Length[ss]-1},{j,i+1,Length@ss}
]
]]];
\[DoubleStruckCapitalO][Subscript[\[DoubleStruckCapitalO], red_,ps_,ss_][\[ScriptCapitalE]_]]:=Subscript[\[DoubleStruckCapitalO], Sort[ss]]@Subscript[\[DoubleStruckCapitalO], red,ps,ss][\[ScriptCapitalE]]


(* ::Input::Initialization:: *)
Subscript[p\[Sigma], x_->y_][Subscript[\[DoubleStruckCapitalO], red_,ps_,ss_][\[ScriptCapitalE]_]]:=Subscript[PP, EMp\[Sigma]]@Subscript[\[DoubleStruckCapitalO], red,Replace[x->y]/@ps,ss][\[ScriptCapitalE]//FA[x->y]]


(* ::Input::Initialization:: *)
Subscript[s\[Sigma], i_->j_][Subscript[\[DoubleStruckCapitalO], red_,ps_,ss_][\[ScriptCapitalE]_]]:=Subscript[PP, EMs\[Sigma]]@Subscript[\[DoubleStruckCapitalO], red,ps,Replace[i->j]/@ss][\[ScriptCapitalE]/.Subscript[\[ScriptCapitalA], a_][A_]:>(Subscript[\[ScriptCapitalA], Replace[i->j]/@a][A//Subscript[\[Sigma], i->j]//Subscript[\[Sigma], \!\(\*OverscriptBox[\(i\), \(_\)]\)->\!\(\*OverscriptBox[\(j\), \(_\)]\)]//Subscript[\[Sigma], \!\(\*OverscriptBox[\(i\), \(~\)]\)->\!\(\*OverscriptBox[\(j\), \(~\)]\)]])]


(* ::Input::Initialization:: *)
Subscript[sm, __][0]=0;
Subscript[\[DoubleStruckCapitalO], red_,ps_,ss_][\[ScriptCapitalE]_]//Subscript[sm, i_,j_->k_]:=Subscript[PP, EMsm]@\[DoubleStruckCapitalO]@Subscript[\[DoubleStruckCapitalO], red,ps,{k}~Join~Complement[ss,{i,j}]][First[Subscript[\[DoubleStruckCapitalO], red,ps,ss][\[ScriptCapitalE]]//\!\(\*SubscriptBox[\(\[DoubleStruckCapitalO]\), \({i, j}~Join~Complement[ss, {i, j}]\)]\)]/.{
Subscript[\[ScriptCapitalA], c[i,j]][A_]:>Subscript[\[ScriptCapitalA], c[k]][A//Subscript[\[Sigma], \!\(\*OverscriptBox[\(j\), \(_\)]\)->\!\(\*OverscriptBox[\(k\), \(~\)]\)]//Subscript[m, \!\(\*OverscriptBox[\(i\), \(_\)]\),j->\!\(\*OverscriptBox[\(k\), \(_\)]\)]//Subscript[\[Sigma], i->k]],
Subscript[\[ScriptCapitalA], c[i]][A_]:>Subscript[\[ScriptCapitalA], c[k]][A//Subscript[m, \!\(\*OverscriptBox[\(i\), \(~\)]\),j->\!\(\*OverscriptBox[\(k\), \(~\)]\)]//Subscript[\[Sigma], i->k]//Subscript[\[Sigma], \!\(\*OverscriptBox[\(i\), \(_\)]\)->\!\(\*OverscriptBox[\(k\), \(_\)]\)]],
Subscript[\[ScriptCapitalA], c[j]][A_]:>Subscript[\[ScriptCapitalA], c[k]][A//Subscript[m, i,j->k]//Subscript[\[Sigma], \!\(\*OverscriptBox[\(j\), \(_\)]\)->\!\(\*OverscriptBox[\(k\), \(_\)]\)]//Subscript[\[Sigma], \!\(\*OverscriptBox[\(j\), \(~\)]\)->\!\(\*OverscriptBox[\(k\), \(~\)]\)]],
Subscript[\[ScriptCapitalA], c[i,x_]][A_]:>Subscript[\[ScriptCapitalA], c[k,x]][A//Subscript[m, \!\(\*OverscriptBox[\(i\), \(_\)]\),j->\!\(\*OverscriptBox[\(k\), \(_\)]\)]//Subscript[\[Sigma], i->k]],
Subscript[\[ScriptCapitalA], c[j,x_]][A_]:>Subscript[\[ScriptCapitalA], c[k,x]][A//Subscript[m, i,j->k]//Subscript[\[Sigma], \!\(\*OverscriptBox[\(j\), \(_\)]\)->\!\(\*OverscriptBox[\(k\), \(_\)]\)]],
Subscript[\[ScriptCapitalA], a_][A_]:>Subscript[\[ScriptCapitalA], a][A//Subscript[m, i,j->k]]
}]


(* ::Input::Initialization:: *)
Subscript[p\[Eta], x_][Subscript[\[DoubleStruckCapitalO], red_,ps_,ss_][\[ScriptCapitalE]_]]:=Subscript[\[DoubleStruckCapitalO], red,ps\[Union]{x},ss][\[ScriptCapitalE]]


(* ::Input::Initialization:: *)
Subscript[s\[Eta], i_][Subscript[\[DoubleStruckCapitalO], red_,ps_,ss_][\[ScriptCapitalE]_]]:=Subscript[\[DoubleStruckCapitalO], red,ps,ss~Join~{i}][\[ScriptCapitalE]/.Subscript[\[ScriptCapitalA], a_][A_]:>Subscript[\[ScriptCapitalA], a][A//Subscript[\[Eta], i]]]


(* ::Input::Initialization:: *)
Subscript[s\[CapitalDelta], i_->j_,k_][Subscript[\[DoubleStruckCapitalO], red_,ps_,ss_][\[ScriptCapitalE]_]]:=Subscript[PP, EMs\[CapitalDelta]]@Module[{u1,u2},
\[DoubleStruckCapitalO]@Subscript[\[DoubleStruckCapitalO], red,ps,Replace[i->Sequence[j,k]]/@ss][\[ScriptCapitalE]/.{
Subscript[\[ScriptCapitalA], 0][A_]:> Subscript[\[ScriptCapitalA], 0][A//Subscript[\[CapitalDelta], i->j,k]]+Subscript[\[ScriptCapitalA], c[j,k]][Sum[Expand[A(Subscript[AW, u1][p]Subscript[AW, u2][]-Subscript[AW, u1][]Subscript[AW, u2][p])]//Subscript[\[DoubleStruckCapitalD][p], i->i,\!\(\*OverscriptBox[\(i\), \(_\)]\)]//Subscript[\[DoubleStruckCapitalD][p], \!\(\*OverscriptBox[\(i\), \(_\)]\)->\!\(\*OverscriptBox[\(i\), \(_\)]\),\!\(\*OverscriptBox[\(i\), \(~\)]\)]//Subscript[\[CapitalDelta], i->j,k]//Subscript[\[CapitalDelta], \!\(\*OverscriptBox[\(i\), \(_\)]\)->\!\(\*OverscriptBox[\(j\), \(_\)]\),\!\(\*OverscriptBox[\(k\), \(_\)]\)]//Subscript[\[CapitalDelta], \!\(\*OverscriptBox[\(i\), \(~\)]\)->\!\(\*OverscriptBox[\(j\), \(~\)]\),\!\(\*OverscriptBox[\(k\), \(~\)]\)]//Subscript[m, j,\!\(\*OverscriptBox[\(j\), \(_\)]\)->j]//Subscript[\[Sigma], \!\(\*OverscriptBox[\(j\), \(~\)]\)->\!\(\*OverscriptBox[\(j\), \(_\)]\)]//Subscript[m, \!\(\*OverscriptBox[\(k\), \(_\)]\),\!\(\*OverscriptBox[\(k\), \(~\)]\)->\!\(\*OverscriptBox[\(k\), \(_\)]\)]//Subscript[m, j,u1->j]//Subscript[m, u2,\!\(\*OverscriptBox[\(j\), \(_\)]\)->\!\(\*OverscriptBox[\(j\), \(_\)]\)],{p,ps}]],
Subscript[\[ScriptCapitalA], c[x_,i]][A_]:>Subscript[\[ScriptCapitalA], c[x,j]][A//Subscript[\[CapitalDelta], i->j,k]//Subscript[\[CapitalDelta], \!\(\*OverscriptBox[\(i\), \(_\)]\)->\!\(\*OverscriptBox[\(j\), \(_\)]\),\!\(\*OverscriptBox[\(k\), \(_\)]\)]//Subscript[m, k,\!\(\*OverscriptBox[\(k\), \(_\)]\)->k]]+Subscript[\[ScriptCapitalA], c[x,k]][A//Subscript[\[CapitalDelta], i->j,k]//Subscript[\[CapitalDelta], \!\(\*OverscriptBox[\(i\), \(_\)]\)->\!\(\*OverscriptBox[\(j\), \(_\)]\),\!\(\*OverscriptBox[\(k\), \(_\)]\)]//Subscript[m, j,\!\(\*OverscriptBox[\(j\), \(_\)]\)->j]],
Subscript[\[ScriptCapitalA], c[i,y_]][A_]:>Subscript[\[ScriptCapitalA], c[j,y]][A//Subscript[\[CapitalDelta], i->j,k]//Subscript[\[CapitalDelta], \!\(\*OverscriptBox[\(i\), \(_\)]\)->\!\(\*OverscriptBox[\(j\), \(_\)]\),\!\(\*OverscriptBox[\(k\), \(_\)]\)]//Subscript[m, k,\!\(\*OverscriptBox[\(k\), \(_\)]\)->k]]+Subscript[\[ScriptCapitalA], c[k,y]][A//Subscript[\[CapitalDelta], i->j,k]//Subscript[\[CapitalDelta], \!\(\*OverscriptBox[\(i\), \(_\)]\)->\!\(\*OverscriptBox[\(j\), \(_\)]\),\!\(\*OverscriptBox[\(k\), \(_\)]\)]//Subscript[m, j,\!\(\*OverscriptBox[\(j\), \(_\)]\)->j]],
Subscript[\[ScriptCapitalA], c[i]][A_]:>Subscript[\[ScriptCapitalA], c[j]][A//Subscript[\[CapitalDelta], i->j,k]//Subscript[\[CapitalDelta], \!\(\*OverscriptBox[\(i\), \(_\)]\)->\!\(\*OverscriptBox[\(j\), \(_\)]\),\!\(\*OverscriptBox[\(k\), \(_\)]\)]//Subscript[\[CapitalDelta], \!\(\*OverscriptBox[\(i\), \(~\)]\)->\!\(\*OverscriptBox[\(j\), \(~\)]\),\!\(\*OverscriptBox[\(k\), \(~\)]\)]//Subscript[m, k,\!\(\*OverscriptBox[\(k\), \(_\)]\)->k]//Subscript[m, k,\!\(\*OverscriptBox[\(k\), \(~\)]\)->k]]+Subscript[\[ScriptCapitalA], c[k]][A//Subscript[\[CapitalDelta], i->j,k]//Subscript[\[CapitalDelta], \!\(\*OverscriptBox[\(i\), \(_\)]\)->\!\(\*OverscriptBox[\(j\), \(_\)]\),\!\(\*OverscriptBox[\(k\), \(_\)]\)]//Subscript[\[CapitalDelta], \!\(\*OverscriptBox[\(i\), \(~\)]\)->\!\(\*OverscriptBox[\(j\), \(~\)]\),\!\(\*OverscriptBox[\(k\), \(~\)]\)]//Subscript[m, j,\!\(\*OverscriptBox[\(j\), \(_\)]\)->j]//Subscript[m, j,\!\(\*OverscriptBox[\(j\), \(~\)]\)->j]]+Subscript[\[ScriptCapitalA], c[j,k]][A//Subscript[\[CapitalDelta], i->j,k]//Subscript[\[CapitalDelta], \!\(\*OverscriptBox[\(i\), \(_\)]\)->\!\(\*OverscriptBox[\(j\), \(_\)]\),\!\(\*OverscriptBox[\(k\), \(_\)]\)]//Subscript[\[CapitalDelta], \!\(\*OverscriptBox[\(i\), \(~\)]\)->\!\(\*OverscriptBox[\(j\), \(~\)]\),\!\(\*OverscriptBox[\(k\), \(~\)]\)]//Subscript[m, \!\(\*OverscriptBox[\(j\), \(_\)]\),\!\(\*OverscriptBox[\(j\), \(~\)]\)->\!\(\*OverscriptBox[\(j\), \(_\)]\)]//Subscript[m, k,\!\(\*OverscriptBox[\(k\), \(_\)]\)->k]//Subscript[\[Sigma], \!\(\*OverscriptBox[\(k\), \(~\)]\)->\!\(\*OverscriptBox[\(k\), \(_\)]\)]]+Subscript[\[ScriptCapitalA], c[j,k]][A//Subscript[\[CapitalDelta], i->j,k]//Subscript[\[CapitalDelta], \!\(\*OverscriptBox[\(i\), \(_\)]\)->\!\(\*OverscriptBox[\(j\), \(_\)]\),\!\(\*OverscriptBox[\(k\), \(_\)]\)]//Subscript[\[CapitalDelta], \!\(\*OverscriptBox[\(i\), \(~\)]\)->\!\(\*OverscriptBox[\(j\), \(~\)]\),\!\(\*OverscriptBox[\(k\), \(~\)]\)]//Subscript[m, \!\(\*OverscriptBox[\(k\), \(_\)]\),\!\(\*OverscriptBox[\(k\), \(~\)]\)->\!\(\*OverscriptBox[\(k\), \(_\)]\)]//Subscript[m, j,\!\(\*OverscriptBox[\(j\), \(_\)]\)->j]//Subscript[\[Sigma], \!\(\*OverscriptBox[\(j\), \(~\)]\)->\!\(\*OverscriptBox[\(j\), \(_\)]\)]],
Subscript[\[ScriptCapitalA], a_][A_]:>Subscript[\[ScriptCapitalA], a][A//Subscript[\[CapitalDelta], i->j,k]]
}]
]


(* ::Input::Initialization:: *)
Subscript[p\[CapitalDelta], x_->y_,z_][Subscript[\[DoubleStruckCapitalO], red_,ps_,ss_][\[ScriptCapitalE]_]]:=Subscript[PP, EMp\[CapitalDelta]]@Subscript[\[DoubleStruckCapitalO], red,Replace[x->Sequence[y,z]]/@ps,ss][\[ScriptCapitalE]/.Subscript[\[ScriptCapitalA], a_][A_]:>Subscript[\[ScriptCapitalA], a][A//FA[x->y+z]]]


(* ::Input::Initialization:: *)
Subscript[p2s, x_->i_][Subscript[\[DoubleStruckCapitalO], red_,ps_,ss_][\[ScriptCapitalE]_]]:=Subscript[PP, EMp2s]@CF@Subscript[\[DoubleStruckCapitalO], red,DeleteCases[ps,x],{i}~Join~ss][\[ScriptCapitalE]/.{
Subscript[\[ScriptCapitalA], 0][A_]:>Subscript[\[ScriptCapitalA], 0][A//FA[x->0]//Subscript[\[Eta], i]]+Sum[
Subscript[\[ScriptCapitalA], c[i,s]][A//Subscript[\[DoubleStruckCapitalD][x], s->s,\!\(\*OverscriptBox[\(s\), \(_\)]\)]//FA[x->0]//Subscript[\[Eta], i]//Subscript[\[Eta], \!\(\*OverscriptBox[\(i\), \(_\)]\)]],
{s,ss}],
Subscript[\[ScriptCapitalA], c_][A_]:>Subscript[\[ScriptCapitalA], c][A//FA[x->0]]
}]


(* ::Input::Initialization:: *)
Subscript[EM, d_][Subscript[\[DoubleStruckCapitalO], red_,ps1_,ss1_][\[ScriptCapitalE]1_],Subscript[\[DoubleStruckCapitalO], red_,ps2_,ss2_][\[ScriptCapitalE]2_]]/;ss1\[Intersection]ss2==={}:=Subscript[PP, EMEM]@Subscript[\[DoubleStruckCapitalO], red,ps1\[Union]ps2,ss1~Join~ss2][Expand[\[ScriptCapitalE]1*\[ScriptCapitalE]2]/.{
Subscript[\[ScriptCapitalA], 0][A1_]Subscript[\[ScriptCapitalA], 0][A2_]:>Subscript[\[ScriptCapitalA], 0][Subscript[EM, d][A1,A2]],
Subscript[\[ScriptCapitalA], 0][A1_]Subscript[\[ScriptCapitalA], c_][A2_]:>Subscript[\[ScriptCapitalA], c][Subscript[EM, d-1][A1,A2]],
Subscript[\[ScriptCapitalA], c1_][_]Subscript[\[ScriptCapitalA], c2_][_]->0
}
]


(* ::Input::Initialization:: *)
Subscript[IM, d_][Subscript[\[DoubleStruckCapitalO], red_,ps_,ss1_][\[ScriptCapitalE]1_],Subscript[\[DoubleStruckCapitalO], red_,ps_,ss2_][\[ScriptCapitalE]2_]]/;Sort[ss1]===Sort[ss2]:=Subscript[PP, EMIM]@Module[{\[ScriptCapitalE],\[Nu]},
\[ScriptCapitalE]=Subscript[\[DoubleStruckCapitalO], red,ps,ss1][\[ScriptCapitalE]2];
Do[\[ScriptCapitalE]=\[ScriptCapitalE]//Subscript[s\[Sigma], s->\[Nu][s]],{s,ss2}];
\[ScriptCapitalE]=Subscript[EM, d][Subscript[\[DoubleStruckCapitalO], red,ps,ss1][\[ScriptCapitalE]1],\[ScriptCapitalE]];
Do[\[ScriptCapitalE]=\[ScriptCapitalE]//Subscript[sm, s,\[Nu][s]->s],{s,ss1}];
\[ScriptCapitalE]
];
Subscript[IM, d_][\[ScriptCapitalE]1_,\[ScriptCapitalE]2_,\[ScriptCapitalE]3__]:=Subscript[IM, d][Subscript[IM, d][\[ScriptCapitalE]1,\[ScriptCapitalE]2],\[ScriptCapitalE]3]
