Pensieve header:  A graded-CU variant.

Date[]
SetDirectory["C:\\drorbn\\AcademicPensieve\\Projects\\FullDoPeGDO"];
Once[<<KnotTheory`];
Once[Get@"../Profile/Profile.m"];
$k=1;
HL[ℰ_] := Style[ℰ, Background -> If[TrueQ@ℰ,,]];
<<Engine.m
<<Objects.m

“Define” Code

SetAttributes[Define, HoldAll];
Define[def_,defs__] := (Define[def]; Define[defs];);
Define[(Subscript[op_, is__])=ℰ_] := Module[{SD,ii,jj,kk,isp,nis,nisp,sis},Block[{i,j,k},
ReleaseHold[Hold[
SD[(Subscript[op, nisp,$k_Integer]),(Subscript[PP, Boot])@Block[{i,j,k},(Subscript[op, isp,$k])=ℰ;(Subscript[op, nis,$k])]];
SD[(Subscript[op, isp]),(Subscript[op, {is},$k])]; SD[(Subscript[op, sis__]),(Subscript[op, {sis}])];
]/. {SD->SetDelayed,
isp->{is}/.{i->i_,j->j_,k->k_},
nis->{is}/.{i->ii,j->jj,k->kk},
nisp->{is}/.{i->ii_,j->jj_,k->kk_}
}]  ]]

H

Symmetric Algebra Objects

(Subscript[H, i_]):=(Subscript[Λ2𝔼, {i}->{i}])[ℏ (Subscript[β, i])(Subscript[b, i])+ℏ (Subscript[τ, i])(Subscript[t, i])+ℏ (Subscript[α, i])(Subscript[a, i])+ℏ (Subscript[η, i])(Subscript[y, i])+ℏ (Subscript[ξ, i])(Subscript[x, i])];

(Subscript[sm, i_,j_->k_]):=(Subscript[Λ2𝔼, {i,j}->{k}])[(Subscript[b, k])((Subscript[β, i])+(Subscript[β, j]))+(Subscript[t, k])((Subscript[τ, i])+(Subscript[τ, j]))+(Subscript[a, k])((Subscript[α, i])+(Subscript[α, j]))+(Subscript[y, k])((Subscript[η, i])+(Subscript[η, j]))+(Subscript[x, k])((Subscript[ξ, i])+(Subscript[ξ, j]))];
(Subscript[sΔ, i_->j_,k_]):=(Subscript[Λ2𝔼, {i}->{j,k}])[(Subscript[β, i])((Subscript[b, j])+(Subscript[b, k]))+(Subscript[τ, i])((Subscript[t, j])+(Subscript[t, k]))+(Subscript[α, i])((Subscript[a, j])+(Subscript[a, k]))+(Subscript[η, i])((Subscript[y, j])+(Subscript[y, k]))+(Subscript[ξ, i])((Subscript[x, j])+(Subscript[x, k]))];
(Subscript[sS, i_]):=(Subscript[Λ2𝔼, {i}->{i}])[-(Subscript[β, i])(Subscript[b, i])-(Subscript[τ, i])(Subscript[t, i])-(Subscript[α, i])(Subscript[a, i])-(Subscript[η, i])(Subscript[y, i])-(Subscript[ξ, i])(Subscript[x, i])];
(Subscript[sη, i_]):=(Subscript[Λ2𝔼, {}->{i}])[0];(Subscript[sϵ, i_]):=(Subscript[Λ2𝔼, {i}->{}])[0];

(Subscript[sσ, i_->j_]):=(Subscript[Λ2𝔼, {i}->{j}])[(Subscript[β, i])(Subscript[b, j])+(Subscript[τ, i])(Subscript[t, j])+(Subscript[α, i])(Subscript[a, j])+(Subscript[η, i])(Subscript[y, j])+(Subscript[ξ, i])(Subscript[x, j])];
(Subscript[sΥ, i_->j_,k_,l_,m_]):=(Subscript[Λ2𝔼, {i}->{j,k,l,m}])[(Subscript[β, i])(Subscript[b, k])+(Subscript[τ, i])(Subscript[t, k])+(Subscript[α, i])(Subscript[a, l])+(Subscript[η, i])(Subscript[y, j])+(Subscript[ξ, i])(Subscript[x, m])];

The CU Definitions

cΛ=((Subscript[η, i])+(((E^(-ℏ (Subscript[α, i])-ℏ ϵ (Subscript[β, i]))) (Subscript[η, j]))/(1+(ℏ^2) ϵ (Subscript[η, j]) (Subscript[ξ, i]))))(Subscript[y, k])+((Subscript[β, i])+(Subscript[β, j])+((Log[1+(ℏ^2) ϵ (Subscript[η, j]) (Subscript[ξ, i])])/(ℏ ϵ)))(Subscript[b, k])+((Subscript[α, i])+(Subscript[α, j])+((Log[1+(ℏ^2) ϵ (Subscript[η, j]) (Subscript[ξ, i])])/ℏ))(Subscript[a, k])+((((E^(-ℏ (Subscript[α, j])-ℏ ϵ (Subscript[β, j]))) (Subscript[ξ, i]))/(1+(ℏ^2) ϵ (Subscript[η, j]) (Subscript[ξ, i])))+(Subscript[ξ, j]))(Subscript[x, k]);
Define[(Subscript[cm, i,j->k])=(Subscript[Λ2𝔼, {i,j}->{k}])[((Subscript[η, i])+(((E^(-ℏ (Subscript[α, i])-ℏ ϵ (Subscript[β, i]))) (Subscript[η, j]))/(1+(ℏ^2) ϵ (Subscript[η, j]) (Subscript[ξ, i]))))(Subscript[y, k])+((Subscript[β, i])+(Subscript[β, j])+((Log[1+(ℏ^2) ϵ (Subscript[η, j]) (Subscript[ξ, i])])/(ℏ ϵ)))(Subscript[b, k])+((Subscript[α, i])+(Subscript[α, j])+((Log[1+(ℏ^2) ϵ (Subscript[η, j]) (Subscript[ξ, i])])/ℏ))(Subscript[a, k])+((((E^(-ℏ (Subscript[α, j])-ℏ ϵ (Subscript[β, j]))) (Subscript[ξ, i]))/(1+(ℏ^2) ϵ (Subscript[η, j]) (Subscript[ξ, i])))+(Subscript[ξ, j]))(Subscript[x, k])]]

(Subscript[cm, 1,2->1])//(Subscript[cm, 1,3->1])

HL[((Subscript[cm, 1,2->1])//(Subscript[cm, 1,3->1]))≡((Subscript[cm, 2,3->2])//(Subscript[cm, 1,2->1]))]

Define[(Subscript[cσ, i->j])=(Subscript[sσ, i,j])/.(Subscript[τ, i])->0,(Subscript[cϵ, i])=(Subscript[sϵ, i]), (Subscript[cη, i])=(Subscript[sη, i]),(Subscript[cΔ, i->j,k])=(Subscript[sΔ, i->j,k]),
(Subscript[cS, i])=(Subscript[sS, i])//(Subscript[sΥ, i->1,2,3,4])//(Subscript[cm, 4,3->i])//(Subscript[cm, i,2->i])//(Subscript[cm, i,1->i])];

HL@Simplify[((Subscript[cm, 1,2->1])//(Subscript[H, 1])//U2l)≡(((Subscript[H, 1])(Subscript[H, 2]))//(Subscript[cm, 1,2->1])//U2l)]

Booting Up QU

Upper to lower and lower to Upper:

U2l[ℰ_]:=ℰ/.{(Subscript[B, i_]^(p_.)):>(E^(-p ℏ (Subscript[b, i]))),(B^(p_.)):>(E^(-p ℏ b)), (Subscript[T, i_]^(p_.)):>(E^(p ℏ (Subscript[t, i]))),(T^(p_.)):>(E^(p ℏ t)),(Subscript[𝒜, i_]^(p_.)):>(E^(p ℏ (Subscript[α, i]))),(𝒜^(p_.)):>(E^(p ℏ α))}; 
l2U[ℰ_]:=ℰ//.{(E^(c_.(Subscript[b, i_])+d_.)):>(Subscript[B, i]^(-c/ℏ))(E^d),(E^(c_.b+d_.)):>(B^(-c/ℏ))(E^d),(E^(c_.(Subscript[t, i_])+d_.)):>(Subscript[T, i]^(c/ℏ))(E^d),(E^(c_.t+d_.)):>(T^(c/ℏ))(E^d),
(E^(c_.(Subscript[α, i_])+d_.)):>(Subscript[𝒜, i]^(c/ℏ))(E^d),(E^(c_.α+d_.)):>(𝒜^(c/ℏ))(E^d),(E^(𝒳_)):>(E^(Expand@𝒳))};
l2U[r_Rule]:=Module[{U=r[[1]]/.{b->B,t->T,α->𝒜}},U->l2U[U2l[U]/.r]];
AlsoUpper[rs_List] := rs⋃(l2U/@rs);

Derivatives in the presence of exponentiated variables:

(Subscript[D, b])[f_]:=(∂_b)f-ℏ B(∂_B)f; (Subscript[D, (Subscript[b, i_])])[f_]:=(∂_(Subscript[b, i]))f-ℏ (Subscript[B, i])(∂_(Subscript[B, i]))f;
(Subscript[D, t])[f_]:=(∂_t)f+ℏ T(∂_T)f; (Subscript[D, (Subscript[t, i_])])[f_]:=(∂_(Subscript[t, i]))f+ℏ (Subscript[T, i])(∂_(Subscript[T, i]))f; 
(Subscript[D, α])[f_]:=(∂_α)f+ℏ 𝒜 (∂_𝒜)f; (Subscript[D, (Subscript[α, i_])])[f_]:=(∂_(Subscript[α, i]))f+ℏ (Subscript[𝒜, i]) (∂_(Subscript[𝒜, i]))f;
(Subscript[D, v_])[f_]:=(∂_v)f;

Define[(Subscript[aσ, i->j])=(Subscript[Λ2𝔼, {i}->{j}])[(Subscript[a, j]) (Subscript[α, i])+(Subscript[x, j]) (Subscript[ξ, i])],(Subscript[bσ, i->j])=(Subscript[Λ2𝔼, {i}->{j}])[(Subscript[b, j]) (Subscript[β, i])+(Subscript[y, j]) (Subscript[η, i])]]

Define[(Subscript[am, i,j->k])=(Subscript[Λ2𝔼, {i,j}->{k}])[((Subscript[α, i])+(Subscript[α, j]))(Subscript[a, k])+((Subscript[𝒜, j]^(-1))(Subscript[ξ, i])+(Subscript[ξ, j]))(Subscript[x, k])],
(Subscript[bm, i,j->k])=(Subscript[Λ2𝔼, {i,j}->{k}])[((Subscript[β, i])+(Subscript[β, j]))(Subscript[b, k])+((Subscript[η, i])+(E^(- ℏ ϵ (Subscript[β, i])))(Subscript[η, j]))(Subscript[y, k])]]

(Subscript[𝒜, j]^(-1))//U2l

{(Subscript[am, 1,2->3]),(Subscript[bm, 1,2->3])}

HL/@{((Subscript[am, 1,2->1])//(Subscript[am, 1,3->1]))≡((Subscript[am, 2,3->2])//(Subscript[am, 1,2->1])),((Subscript[bm, 1,2->1])//(Subscript[bm, 1,3->1]))≡((Subscript[bm, 2,3->2])//(Subscript[bm, 1,2->1]))}

(Subscript[bm, 1,2->1])//(Subscript[H, 1])//U2l
((Subscript[H, 1])(Subscript[H, 2]))//(Subscript[bm, 1,2->1])//U2l

HL@Simplify[((Subscript[bm, 1,2->1])//(Subscript[H, 1])//U2l)≡(((Subscript[H, 1])(Subscript[H, 2]))//(Subscript[bm, 1,2->1])//U2l)]

HL@Simplify[((Subscript[am, 1,2->1])//(Subscript[H, 1])//U2l)≡(((Subscript[H, 1])(Subscript[H, 2]))//(Subscript[am, 1,2->1])//U2l)]

Define[(Subscript[R, i,j])=Module[{k},(Subscript[Λ2𝔼, {}->{i,j}])[ℏ (Subscript[a, j]) (Subscript[b, i])+(∑_(k=1)^($k+1)) (((((1-(E^(ϵ (ℏ^3)))))^k)(((ℏ (Subscript[y, i])(Subscript[x, j])))^k))/(k(1-(E^(k ϵ (ℏ^3))))))]]]

(Subscript[R, i,j])

Define[(Subscript[(OverBar[R]), i,j])=If[$k==0,(Subscript[𝔼, {}->{i,j}])[-ℏ (Subscript[a, j]) (Subscript[b, i])-ℏ (Subscript[x, j]) (Subscript[y, i])/(Subscript[B, i])],Append[(Subscript[(OverBar[R]), {i,j},$k-1]),-Last[PadRight[(Subscript[(OverBar[R]), {i,j},0]),$k+1](Subscript[R, 1,2])PadRight[(Subscript[(OverBar[R]), {3,4},$k-1]),$k+1]//((Subscript[bm, i,1->i])(Subscript[am, j,2->j]))//((Subscript[bm, i,3->i])(Subscript[am, j,4->j]))]]]
]

(Subscript[(OverBar[R]), i,j])

((Subscript[(OverBar[R]), 1,2])(Subscript[R, 3,4]))//((Subscript[dm, 1,3->1])(Subscript[dm, 2,4->2]))

Import from Testing.nb

$k=3;(Subscript[(OverBar[R]), i,j])

$k=3;(Subscript[P, i,j])

$k=3; (Subscript[aS, i])

$k=3; (Subscript[(OverBar[aS]), i])

((Subscript[(OverBar[aS]), 1])//(Subscript[aS, 1]))

((Subscript[(OverBar[aS]), 1])//(Subscript[aS, 1]))

((Subscript[(OverBar[bS]), 1])//(Subscript[bS, 1]))

$k=1

(Subscript[dS, 1])

𝔽=𝔼; (Subscript[dS, 1])≡(Subscript[𝔽, {1}->{1}])[-(Subscript[a, 1]) (Subscript[α, 1])-(Subscript[b, 1]) (Subscript[β, 1])-(((Subscript[y, 1]) (Subscript[𝒜, 1]) (Subscript[η, 1]))/(Subscript[B, 1]))-(Subscript[x, 1]) (Subscript[𝒜, 1]) (Subscript[ξ, 1])+((((Subscript[𝒜, 1])-(Subscript[B, 1]) (Subscript[𝒜, 1])) (Subscript[η, 1]) (Subscript[ξ, 1]))/(ℏ (Subscript[B, 1]))),((ℏ (Subscript[y, 1]) (Subscript[𝒜, 1]) (Subscript[η, 1]))/(Subscript[B, 1]))-(((Subscript[y, 1]) (Subscript[𝒜, 1]) (Subscript[β, 1]) (Subscript[η, 1]))/(Subscript[B, 1]))-((ℏ (Subscript[y, 1]^2) (Subscript[𝒜, 1]^2) (Subscript[η, 1]^2))/(2 (Subscript[B, 1]^2)))-ℏ (Subscript[a, 1]) (Subscript[x, 1]) (Subscript[𝒜, 1]) (Subscript[ξ, 1])-(Subscript[x, 1]) (Subscript[𝒜, 1]) (Subscript[β, 1]) (Subscript[ξ, 1])+(((Subscript[a, 1]) (Subscript[𝒜, 1]) (Subscript[η, 1]) (Subscript[ξ, 1]))/(Subscript[B, 1]))-((ℏ (Subscript[x, 1]) (Subscript[y, 1]) (Subscript[𝒜, 1]^2) (Subscript[η, 1]) (Subscript[ξ, 1]))/(Subscript[B, 1]))+(((-(Subscript[𝒜, 1])+(Subscript[B, 1]) (Subscript[𝒜, 1])) (Subscript[η, 1]) (Subscript[ξ, 1]))/(Subscript[B, 1]))+((((Subscript[𝒜, 1])-(Subscript[B, 1]) (Subscript[𝒜, 1])) (Subscript[β, 1]) (Subscript[η, 1]) (Subscript[ξ, 1]))/(ℏ (Subscript[B, 1])))+(((Subscript[y, 1]) (3 (Subscript[𝒜, 1]^2)-(Subscript[B, 1]) (Subscript[𝒜, 1]^2)) (Subscript[η, 1]^2) (Subscript[ξ, 1]))/(2 (Subscript[B, 1]^2)))-(1/2) ℏ (Subscript[x, 1]^2) (Subscript[𝒜, 1]^2) (Subscript[ξ, 1]^2)+(((Subscript[x, 1]) (3 (Subscript[𝒜, 1]^2)-(Subscript[B, 1]) (Subscript[𝒜, 1]^2)) (Subscript[η, 1]) (Subscript[ξ, 1]^2))/(2 (Subscript[B, 1])))+(((-3 (Subscript[𝒜, 1]^2)+4 (Subscript[B, 1]) (Subscript[𝒜, 1]^2)-(Subscript[B, 1]^2) (Subscript[𝒜, 1]^2)) (Subscript[η, 1]^2) (Subscript[ξ, 1]^2))/(4 ℏ (Subscript[B, 1]^2)))]

(Subscript[(OverBar[dS]), 1])≡(Subscript[𝔽, {1}->{1}])[-(Subscript[a, 1]) (Subscript[α, 1])-(Subscript[b, 1]) (Subscript[β, 1])-(((Subscript[y, 1]) (Subscript[𝒜, 1]) (Subscript[η, 1]))/(Subscript[B, 1]))-(Subscript[x, 1]) (Subscript[𝒜, 1]) (Subscript[ξ, 1])+((((Subscript[𝒜, 1])-(Subscript[B, 1]) (Subscript[𝒜, 1])) (Subscript[η, 1]) (Subscript[ξ, 1]))/(ℏ (Subscript[B, 1]))),-(((Subscript[y, 1]) (Subscript[𝒜, 1]) (Subscript[β, 1]) (Subscript[η, 1]))/(Subscript[B, 1]))-((ℏ (Subscript[y, 1]^2) (Subscript[𝒜, 1]^2) (Subscript[η, 1]^2))/(2 (Subscript[B, 1]^2)))+ℏ (Subscript[x, 1]) (Subscript[𝒜, 1]) (Subscript[ξ, 1])-ℏ (Subscript[a, 1]) (Subscript[x, 1]) (Subscript[𝒜, 1]) (Subscript[ξ, 1])-(Subscript[x, 1]) (Subscript[𝒜, 1]) (Subscript[β, 1]) (Subscript[ξ, 1])+(((Subscript[a, 1]) (Subscript[𝒜, 1]) (Subscript[η, 1]) (Subscript[ξ, 1]))/(Subscript[B, 1]))-((ℏ (Subscript[x, 1]) (Subscript[y, 1]) (Subscript[𝒜, 1]^2) (Subscript[η, 1]) (Subscript[ξ, 1]))/(Subscript[B, 1]))+(((-(Subscript[𝒜, 1])+(Subscript[B, 1]) (Subscript[𝒜, 1])) (Subscript[η, 1]) (Subscript[ξ, 1]))/(Subscript[B, 1]))+((((Subscript[𝒜, 1])-(Subscript[B, 1]) (Subscript[𝒜, 1])) (Subscript[β, 1]) (Subscript[η, 1]) (Subscript[ξ, 1]))/(ℏ (Subscript[B, 1])))+(((Subscript[y, 1]) (3 (Subscript[𝒜, 1]^2)-(Subscript[B, 1]) (Subscript[𝒜, 1]^2)) (Subscript[η, 1]^2) (Subscript[ξ, 1]))/(2 (Subscript[B, 1]^2)))-(1/2) ℏ (Subscript[x, 1]^2) (Subscript[𝒜, 1]^2) (Subscript[ξ, 1]^2)+(((Subscript[x, 1]) (3 (Subscript[𝒜, 1]^2)-(Subscript[B, 1]) (Subscript[𝒜, 1]^2)) (Subscript[η, 1]) (Subscript[ξ, 1]^2))/(2 (Subscript[B, 1])))+(((-3 (Subscript[𝒜, 1]^2)+4 (Subscript[B, 1]) (Subscript[𝒜, 1]^2)-(Subscript[B, 1]^2) (Subscript[𝒜, 1]^2)) (Subscript[η, 1]^2) (Subscript[ξ, 1]^2))/(4 ℏ (Subscript[B, 1]^2)))]

(Subscript[dS, 1])//(Subscript[(OverBar[dS]), 1])

(Subscript[𝔼, {1}->{1}])[-(Subscript[a, 1]) (Subscript[α, 1])-(Subscript[b, 1]) (Subscript[β, 1])-(((Subscript[y, 1]) (Subscript[𝒜, 1]) (Subscript[η, 1]))/(Subscript[B, 1]))-(Subscript[x, 1]) (Subscript[𝒜, 1]) (Subscript[ξ, 1])+((((Subscript[𝒜, 1])-(Subscript[B, 1]) (Subscript[𝒜, 1])) (Subscript[η, 1]) (Subscript[ξ, 1]))/(ℏ (Subscript[B, 1]))),(((ℏ (Subscript[y, 1]) (Subscript[𝒜, 1]) (Subscript[η, 1]))/(Subscript[B, 1]))-(((Subscript[y, 1]) (Subscript[𝒜, 1]) (Subscript[β, 1]) (Subscript[η, 1]))/(Subscript[B, 1]))-((ℏ (Subscript[y, 1]^2) (Subscript[𝒜, 1]^2) (Subscript[η, 1]^2))/(2 (Subscript[B, 1]^2)))-ℏ (Subscript[a, 1]) (Subscript[x, 1]) (Subscript[𝒜, 1]) (Subscript[ξ, 1])-(Subscript[x, 1]) (Subscript[𝒜, 1]) (Subscript[β, 1]) (Subscript[ξ, 1])+(((Subscript[a, 1]) (Subscript[𝒜, 1]) (Subscript[η, 1]) (Subscript[ξ, 1]))/(Subscript[B, 1]))-((ℏ (Subscript[x, 1]) (Subscript[y, 1]) (Subscript[𝒜, 1]^2) (Subscript[η, 1]) (Subscript[ξ, 1]))/(Subscript[B, 1]))+(((-(Subscript[𝒜, 1])+(Subscript[B, 1]) (Subscript[𝒜, 1])) (Subscript[η, 1]) (Subscript[ξ, 1]))/(Subscript[B, 1]))+((((Subscript[𝒜, 1])-(Subscript[B, 1]) (Subscript[𝒜, 1])) (Subscript[β, 1]) (Subscript[η, 1]) (Subscript[ξ, 1]))/(ℏ (Subscript[B, 1])))+(((Subscript[y, 1]) (3 (Subscript[𝒜, 1]^2)-(Subscript[B, 1]) (Subscript[𝒜, 1]^2)) (Subscript[η, 1]^2) (Subscript[ξ, 1]))/(2 (Subscript[B, 1]^2)))-(1/2) ℏ (Subscript[x, 1]^2) (Subscript[𝒜, 1]^2) (Subscript[ξ, 1]^2)+(((Subscript[x, 1]) (3 (Subscript[𝒜, 1]^2)-(Subscript[B, 1]) (Subscript[𝒜, 1]^2)) (Subscript[η, 1]) (Subscript[ξ, 1]^2))/(2 (Subscript[B, 1])))+(((-3 (Subscript[𝒜, 1]^2)+4 (Subscript[B, 1]) (Subscript[𝒜, 1]^2)-(Subscript[B, 1]^2) (Subscript[𝒜, 1]^2)) (Subscript[η, 1]^2) (Subscript[ξ, 1]^2))/(4 ℏ (Subscript[B, 1]^2))))]//(Subscript[𝔼, {1}->{1}])[-(Subscript[a, 1]) (Subscript[α, 1])-(Subscript[b, 1]) (Subscript[β, 1])-(((Subscript[y, 1]) (Subscript[𝒜, 1]) (Subscript[η, 1]))/(Subscript[B, 1]))-(Subscript[x, 1]) (Subscript[𝒜, 1]) (Subscript[ξ, 1])+((((Subscript[𝒜, 1])-(Subscript[B, 1]) (Subscript[𝒜, 1])) (Subscript[η, 1]) (Subscript[ξ, 1]))/(ℏ (Subscript[B, 1]))),-(((Subscript[y, 1]) (Subscript[𝒜, 1]) (Subscript[β, 1]) (Subscript[η, 1]))/(Subscript[B, 1]))-((ℏ (Subscript[y, 1]^2) (Subscript[𝒜, 1]^2) (Subscript[η, 1]^2))/(2 (Subscript[B, 1]^2)))+ℏ (Subscript[x, 1]) (Subscript[𝒜, 1]) (Subscript[ξ, 1])-ℏ (Subscript[a, 1]) (Subscript[x, 1]) (Subscript[𝒜, 1]) (Subscript[ξ, 1])-(Subscript[x, 1]) (Subscript[𝒜, 1]) (Subscript[β, 1]) (Subscript[ξ, 1])+(( (Subscript[a, 1]) (Subscript[𝒜, 1]) (Subscript[η, 1]) (Subscript[ξ, 1]))/(Subscript[B, 1]))-((ℏ (Subscript[x, 1]) (Subscript[y, 1]) (Subscript[𝒜, 1]^2) (Subscript[η, 1]) (Subscript[ξ, 1]))/(Subscript[B, 1]))+(((-(Subscript[𝒜, 1])+(Subscript[B, 1]) (Subscript[𝒜, 1])) (Subscript[η, 1]) (Subscript[ξ, 1]))/(Subscript[B, 1]))+((((Subscript[𝒜, 1])-(Subscript[B, 1]) (Subscript[𝒜, 1])) (Subscript[β, 1]) (Subscript[η, 1]) (Subscript[ξ, 1]))/(ℏ (Subscript[B, 1])))+(((Subscript[y, 1]) (3 (Subscript[𝒜, 1]^2)-(Subscript[B, 1]) (Subscript[𝒜, 1]^2)) (Subscript[η, 1]^2) (Subscript[ξ, 1]))/(2 (Subscript[B, 1]^2)))-(1/2) ℏ (Subscript[x, 1]^2) (Subscript[𝒜, 1]^2) (Subscript[ξ, 1]^2)+(((Subscript[x, 1]) (3 (Subscript[𝒜, 1]^2)-(Subscript[B, 1]) (Subscript[𝒜, 1]^2)) (Subscript[η, 1]) (Subscript[ξ, 1]^2))/(2 (Subscript[B, 1])))+(((-3 (Subscript[𝒜, 1]^2)+4 (Subscript[B, 1]) (Subscript[𝒜, 1]^2)-(Subscript[B, 1]^2) (Subscript[𝒜, 1]^2)) (Subscript[η, 1]^2) (Subscript[ξ, 1]^2))/(4 ℏ (Subscript[B, 1]^2)))]

(Subscript[𝔼, {1}->{1}])[-(Subscript[a, 1]) (Subscript[α, 1])-(Subscript[b, 1]) (Subscript[β, 1])-(((Subscript[y, 1]) (Subscript[𝒜, 1]) (Subscript[η, 1]))/(Subscript[B, 1]))-(Subscript[x, 1]) (Subscript[𝒜, 1]) (Subscript[ξ, 1])+((((Subscript[𝒜, 1])-(Subscript[B, 1]) (Subscript[𝒜, 1])) (Subscript[η, 1]) (Subscript[ξ, 1]))/(ℏ (Subscript[B, 1]))),(((ℏ (Subscript[y, 1]) (Subscript[𝒜, 1]) (Subscript[η, 1]))/(Subscript[B, 1]))-(((Subscript[y, 1]) (Subscript[𝒜, 1]) (Subscript[β, 1]) (Subscript[η, 1]))/(Subscript[B, 1]))-((ℏ (Subscript[y, 1]^2) (Subscript[𝒜, 1]^2) (Subscript[η, 1]^2))/(2 (Subscript[B, 1]^2)))-ℏ (Subscript[a, 1]) (Subscript[x, 1]) (Subscript[𝒜, 1]) (Subscript[ξ, 1])-(Subscript[x, 1]) (Subscript[𝒜, 1]) (Subscript[β, 1]) (Subscript[ξ, 1])+(((Subscript[a, 1]) (Subscript[𝒜, 1]) (Subscript[η, 1]) (Subscript[ξ, 1]))/(Subscript[B, 1]))-((ℏ (Subscript[x, 1]) (Subscript[y, 1]) (Subscript[𝒜, 1]^2) (Subscript[η, 1]) (Subscript[ξ, 1]))/(Subscript[B, 1]))+(((-(Subscript[𝒜, 1])+(Subscript[B, 1]) (Subscript[𝒜, 1])) (Subscript[η, 1]) (Subscript[ξ, 1]))/(Subscript[B, 1]))+((((Subscript[𝒜, 1])-(Subscript[B, 1]) (Subscript[𝒜, 1])) (Subscript[β, 1]) (Subscript[η, 1]) (Subscript[ξ, 1]))/(ℏ (Subscript[B, 1])))+(((Subscript[y, 1]) (3 (Subscript[𝒜, 1]^2)-(Subscript[B, 1]) (Subscript[𝒜, 1]^2)) (Subscript[η, 1]^2) (Subscript[ξ, 1]))/(2 (Subscript[B, 1]^2)))-(1/2) ℏ (Subscript[x, 1]^2) (Subscript[𝒜, 1]^2) (Subscript[ξ, 1]^2)+(((Subscript[x, 1]) (3 (Subscript[𝒜, 1]^2)-(Subscript[B, 1]) (Subscript[𝒜, 1]^2)) (Subscript[η, 1]) (Subscript[ξ, 1]^2))/(2 (Subscript[B, 1])))+(((-3 (Subscript[𝒜, 1]^2)+4 (Subscript[B, 1]) (Subscript[𝒜, 1]^2)-(Subscript[B, 1]^2) (Subscript[𝒜, 1]^2)) (Subscript[η, 1]^2) (Subscript[ξ, 1]^2))/(4 ℏ (Subscript[B, 1]^2))))]//(Subscript[𝔼, {1}->{1}])[-(Subscript[a, 1]) (Subscript[α, 1])-(Subscript[b, 1]) (Subscript[β, 1])-(((Subscript[y, 1]) (Subscript[𝒜, 1]) (Subscript[η, 1]))/(Subscript[B, 1]))-(Subscript[x, 1]) (Subscript[𝒜, 1]) (Subscript[ξ, 1])+((((Subscript[𝒜, 1])-(Subscript[B, 1]) (Subscript[𝒜, 1])) (Subscript[η, 1]) (Subscript[ξ, 1]))/(ℏ (Subscript[B, 1]))),-(((Subscript[y, 1]) (Subscript[𝒜, 1]) (Subscript[β, 1]) (Subscript[η, 1]))/(Subscript[B, 1]))-((ℏ (Subscript[y, 1]^2) (Subscript[𝒜, 1]^2) (Subscript[η, 1]^2))/(2 (Subscript[B, 1]^2)))+ℏ (Subscript[x, 1]) (Subscript[𝒜, 1]) (Subscript[ξ, 1])-ℏ (Subscript[a, 1]) (Subscript[x, 1]) (Subscript[𝒜, 1]) (Subscript[ξ, 1])-(Subscript[x, 1]) (Subscript[𝒜, 1]) (Subscript[β, 1]) (Subscript[ξ, 1])+(((Subscript[a, 1]) (Subscript[𝒜, 1]) (Subscript[η, 1]) (Subscript[ξ, 1]))/(Subscript[B, 1]))-((ℏ (Subscript[x, 1]) (Subscript[y, 1]) (Subscript[𝒜, 1]^2) (Subscript[η, 1]) (Subscript[ξ, 1]))/(Subscript[B, 1]))+(((-(Subscript[𝒜, 1])+(Subscript[B, 1]) (Subscript[𝒜, 1])) (Subscript[η, 1]) (Subscript[ξ, 1]))/(Subscript[B, 1]))+((((Subscript[𝒜, 1])-(Subscript[B, 1]) (Subscript[𝒜, 1])) (Subscript[β, 1]) (Subscript[η, 1]) (Subscript[ξ, 1]))/(ℏ (Subscript[B, 1])))+(((Subscript[y, 1]) (3 (Subscript[𝒜, 1]^2)-(Subscript[B, 1]) (Subscript[𝒜, 1]^2)) (Subscript[η, 1]^2) (Subscript[ξ, 1]))/(2 (Subscript[B, 1]^2)))-(1/2) ℏ (Subscript[x, 1]^2) (Subscript[𝒜, 1]^2) (Subscript[ξ, 1]^2)+(((Subscript[x, 1]) (3 (Subscript[𝒜, 1]^2)-(Subscript[B, 1]) (Subscript[𝒜, 1]^2)) (Subscript[η, 1]) (Subscript[ξ, 1]^2))/(2 (Subscript[B, 1])))+(((-3 (Subscript[𝒜, 1]^2)+4 (Subscript[B, 1]) (Subscript[𝒜, 1]^2)-(Subscript[B, 1]^2) (Subscript[𝒜, 1]^2)) (Subscript[η, 1]^2) (Subscript[ξ, 1]^2))/(4 ℏ (Subscript[B, 1]^2)))]

(Subscript[𝔼, {1}->{1}])[(Subscript[a, 1]) (Subscript[α, 1])+(Subscript[b, 1]) (Subscript[β, 1])+(Subscript[y, 1]) (Subscript[η, 1])+(Subscript[x, 1]) (Subscript[ξ, 1]),(ℏ-ℏ ) (Subscript[x, 1]) (Subscript[y, 1]) (Subscript[η, 1]) (Subscript[ξ, 1])+(- (Subscript[𝒜, 1])+ (Subscript[𝒜, 1])+ (Subscript[𝒜, 1])+ (Subscript[B, 1]) (Subscript[𝒜, 1])- (Subscript[B, 1]) (Subscript[𝒜, 1])- (Subscript[B, 1]) (Subscript[𝒜, 1])- (Subscript[𝒜, 1]^2)+ (Subscript[B, 1]) (Subscript[𝒜, 1]^2)) (Subscript[η, 1]) (Subscript[ξ, 1])+((((Subscript[𝒜, 1])- (Subscript[𝒜, 1])-(Subscript[B, 1]) (Subscript[𝒜, 1])+ (Subscript[B, 1]) (Subscript[𝒜, 1])) (Subscript[β, 1]) (Subscript[η, 1]) (Subscript[ξ, 1]))/ℏ)+(Subscript[y, 1]) (- (Subscript[𝒜, 1])+ (Subscript[𝒜, 1])+ (Subscript[B, 1]) (Subscript[𝒜, 1])- (Subscript[B, 1]) (Subscript[𝒜, 1])) (Subscript[η, 1]^2) (Subscript[ξ, 1])+(Subscript[x, 1]) ((Subscript[𝒜, 1])- (Subscript[𝒜, 1])-(Subscript[B, 1]) (Subscript[𝒜, 1])+ (Subscript[B, 1]) (Subscript[𝒜, 1])) (Subscript[η, 1]) (Subscript[ξ, 1]^2)+(((- (Subscript[𝒜, 1]^2)+ (Subscript[𝒜, 1]^2)-(Subscript[B, 1]) (Subscript[𝒜, 1]^2)+2  (Subscript[B, 1]) (Subscript[𝒜, 1]^2)- (Subscript[B, 1]) (Subscript[𝒜, 1]^2)+(Subscript[B, 1]^2) (Subscript[𝒜, 1]^2)- (Subscript[B, 1]^2) (Subscript[𝒜, 1]^2)) (Subscript[η, 1]^2) (Subscript[ξ, 1]^2))/ℏ)]/.{Red|Green|Blue->1}

(Subscript[𝔼, {1}->{1}])[-(Subscript[a, 1]) (Subscript[α, 1])-(Subscript[b, 1]) (Subscript[β, 1])-(((Subscript[y, 1]) (Subscript[𝒜, 1]) (Subscript[η, 1]))/(Subscript[B, 1]))-(Subscript[x, 1]) (Subscript[𝒜, 1]) (Subscript[ξ, 1])+((((Subscript[𝒜, 1])-(Subscript[B, 1]) (Subscript[𝒜, 1])) (Subscript[η, 1]) (Subscript[ξ, 1]))/(ℏ (Subscript[B, 1]))),0]//(Subscript[𝔼, {1}->{1}])[-(Subscript[a, 1]) (Subscript[α, 1])-(Subscript[b, 1]) (Subscript[β, 1])-(((Subscript[y, 1]) (Subscript[𝒜, 1]) (Subscript[η, 1]))/(Subscript[B, 1]))-(Subscript[x, 1]) (Subscript[𝒜, 1]) (Subscript[ξ, 1])+((((Subscript[𝒜, 1])-(Subscript[B, 1]) (Subscript[𝒜, 1])) (Subscript[η, 1]) (Subscript[ξ, 1]))/(ℏ (Subscript[B, 1]))),((((Subscript[𝒜, 1])-(Subscript[B, 1]) (Subscript[𝒜, 1])) (Subscript[β, 1]) (Subscript[η, 1]) (Subscript[ξ, 1]))/(ℏ (Subscript[B, 1])))]

((Subscript[kR, 1,4])(Subscript[(OverBar[kR]), 5,2])(Subscript[(OverBar[kC]), 3]))//(Subscript[km, 2,4->2])//(Subscript[km, 1,3->1])//(Subscript[km, 1,5->1])

(Subscript[(OverBar[kC]), 1])(Subscript[dη, 2])

((Subscript[𝔼, {}->{1,2}])[0,(Subscript[a, 2])(Subscript[x, 1])]//(Subscript[am, 1,2->1]))

$k=2; 𝔼2Λ[(Subscript[𝔼, {}->{1,2}])[0,(Subscript[y, 2])(Subscript[b, 1])]//(Subscript[bm, 1,2->1])]

(Subscript[𝔼, {}->{1,2}])[0,(Subscript[y, 2])(Subscript[b, 1])]