Pensieve header:  Testing suite for the FullDoPeGDO project.

Date[]
SetDirectory["C:\\Users\\T15Roland\\Wiskunde\\Bn\\ProgramFullDoPegDO"];
Once[<<KnotTheory`];
(*Once[Get@"../Profile/Profile.m"];*)
(Subscript[PP, _])=Identity;
$k=1;
<<Engine.m
<<ObjectsR.m

HL[ℰ_] := Style[ℰ, Background -> If[TrueQ@ℰ,,]];

Testing

co-associativity

((Subscript[dΔ, 1->1,2])//(Subscript[dΔ, 2->2,3]))≡((Subscript[dΔ, 1->2,3])//(Subscript[dΔ, 2->1,2]))

algebra morphism

((Subscript[dΔ, i->1,2])(Subscript[dΔ, j->3,4])//(Subscript[dm, 1,3->i])//(Subscript[dm, 2,4->j]))≡((Subscript[dm, i,j->k])//(Subscript[dΔ, k->i,j]))

associativity

((Subscript[dm, 1,2->k])//(Subscript[dm, k,3->k]))≡((Subscript[dm, 2,3->k])//(Subscript[dm, 1,k->k]))

antipode

(Subscript[dΔ, i->1,2])//(Subscript[dS, 1])//(Subscript[dm, 1,2->1])
(Subscript[dΔ, i->1,2])//(Subscript[dS, 2])//(Subscript[dm, 1,2->1])

quasi-triangular axioms

((Subscript[R, 1,3])//(Subscript[dΔ, 1->1,2]))≡((Subscript[R, 1,3])(Subscript[R, 2,4])//(Subscript[dm, 3,4->3]))
((Subscript[R, 1,3])//(Subscript[dΔ, 3->2,3]))≡((Subscript[R, 1,3])(Subscript[R, 0,2])//(Subscript[dm, 1,0->1]))
((Subscript[dΔ, i->k,j])(Subscript[R, 1,2])//(Subscript[dm, j,1->1])//(Subscript[dm, k,2->2]))≡((Subscript[R, 1,2])(Subscript[dΔ, i->j,k])//(Subscript[dm, 1,j->1])//(Subscript[dm, 2,k->2]))

((Subscript[R, 1,2])//(Subscript[aS, 2]))≡((Subscript[(OverBar[R]), 1,2]))

{(*Rotational Reidemeister moves*)
((Subscript[(OverBar[C]), 1])(Subscript[(OverBar[C]), 2])(Subscript[R, 3,4])(Subscript[C, 5])(Subscript[C, 6])//(Subscript[dm, 1,3->1])//(Subscript[dm, 1,5->1])//(Subscript[dm, 2,4->2])//(Subscript[dm, 2,6->2]))≡(Subscript[R, 1,2]),
((Subscript[(OverBar[C]), 1])(Subscript[(OverBar[C]), 2])(Subscript[(OverBar[R]), 4,3])(Subscript[C, 5])(Subscript[C, 6])//(Subscript[dm, 1,3->1])//(Subscript[dm, 1,5->i])//(Subscript[dm, 2,4->2])//(Subscript[dm, 2,6->j]))≡(Subscript[(OverBar[R]), j,i]),
((Subscript[R, 3,1])(Subscript[C, 2])//(Subscript[dm, 1,2->1])//(Subscript[dm, 1,3->i]))≡((Subscript[R, 1,3])(Subscript[(OverBar[C]), 2])//(Subscript[dm, 1,2->1])//(Subscript[dm, 1,3->i])),
((Subscript[(OverBar[R]), 1,2])(Subscript[R, 3,4])//(Subscript[dm, 1,3->j])//(Subscript[dm, 2,4->i]))≡(Subscript[dη, i])(Subscript[dη, j]),
((Subscript[(OverBar[R]), 1,6])(Subscript[R, 3,2])(Subscript[C, 4])//(Subscript[dm, 1,3->i])//(Subscript[dm, 2,4->2])//(Subscript[dm, 2,6->j]))≡(Subscript[dη, i])(Subscript[C, j]),
((Subscript[R, 1,2])(Subscript[R, 4,3])(Subscript[R, 5,6])//(Subscript[dm, 1,4->i])//(Subscript[dm, 2,5->j])//(Subscript[dm, 3,6->k]))≡((Subscript[R, 1,6])(Subscript[R, 2,3])(Subscript[R, 4,5])//(Subscript[dm, 1,4->i])//(Subscript[dm, 2,5->j])//(Subscript[dm, 3,6->k]))}

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

(Subscript[R, 1,2])

$k=2;(Subscript[cm, 1,2->1])//(Subscript[cm, 1,3->1])

Timing@Block[{$k=2},HL[((Subscript[cm, 1,2->1])//(Subscript[cm, 1,3->1]))≡((Subscript[cm, 2,3->2])//(Subscript[cm, 1,2->1]))]]

Timing@Block[{$k=3},HL[((Subscript[cm, 1,2->1])//(Subscript[cm, 1,3->1]))≡((Subscript[cm, 2,3->2])//(Subscript[cm, 1,2->1]))]]

Timing@Block[{$k=4},HL[((Subscript[cm, 1,2->1])//(Subscript[cm, 1,3->1]))≡((Subscript[cm, 2,3->2])//(Subscript[cm, 1,2->1]))]]

Timing@Block[{$k=5},HL[((Subscript[cm, 1,2->1])//(Subscript[cm, 1,3->1]))≡((Subscript[cm, 2,3->2])//(Subscript[cm, 1,2->1]))]]

Timing@Block[{$k=6},HL[((Subscript[cm, 1,2->1])//(Subscript[cm, 1,3->1]))≡((Subscript[cm, 2,3->2])//(Subscript[cm, 1,2->1]))]]

Timing@Block[{$k=7},HL[((Subscript[cm, 1,2->1])//(Subscript[cm, 1,3->1]))≡((Subscript[cm, 2,3->2])//(Subscript[cm, 1,2->1]))]]

Timing@Block[{$k=8},HL[((Subscript[cm, 1,2->1])//(Subscript[cm, 1,3->1]))≡((Subscript[cm, 2,3->2])//(Subscript[cm, 1,2->1]))]]

(Subscript[aσ, 1->2])

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

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

Block[{$k=8},(Subscript[R, 1,2])]

Timing@Block[{$k=8},
HL/@{((Subscript[am, 1,2->1])//(Subscript[am, 1,3->1]))≡Echo@((Subscript[am, 2,3->2])//(Subscript[am, 1,2->1])),((Subscript[bm, 1,2->1])//(Subscript[bm, 1,3->1]))≡Echo@((Subscript[bm, 2,3->2])//(Subscript[bm, 1,2->1]))}
]

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

$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])]