Pensieve header: The OneCo propject using the (b-ϵc)-scapegoated low algebra.

ϵ /: (ϵ^2)=0;
PBWBasis={c,u,w};
FullPBWBasis=PBWBasis⋃((Subscript[#, _])& /@ PBWBasis)⋃{ϵ};
IndexedScalars={b};
b[c,w]=-(b[w,c]=w);
b[u,c]=-(b[c,u]=u);
b[w,u]=-(b[u,w]=b-2ϵ c);

b[x_,x_]=0;
b[(Subscript[(x_), i_]),(Subscript[(y_), i_])]:=b[(Subscript[x, i]),(Subscript[y, i])]=b[x,y]/.Table[z->(Subscript[z, i]),{z,PBWBasis⋃IndexedScalars}];
b[(Subscript[(x_), i_]),(Subscript[(y_), j_])] /; i=!=j := 0;
b[x_,y_] := x**y-y**x;

Simp[ℰ_]:= Collect[ℰ, FullPBWBasis, Simplify]

ScalarQ = FreeQ[Alternatives@@PBWBasis];
AtomicQ = MatchQ[Alternatives@@Flatten[{#,(Subscript[#, _])}& /@ PBWBasis]];
DecomposableQ[x_Plus] = False; DecomposableQ[x_] := !(ScalarQ[x]∨AtomicQ[x]);
Type[(Subscript[(x_), _])]:=Type[x];
Type /: Type[x_]<Type[y_] := Position[PBWBasis,x][[1,1]]<Position[PBWBasis,y][[1,1]];
Type /: Type[x_]≤Type[y_] := Position[PBWBasis,x][[1,1]]≤Position[PBWBasis,y][[1,1]];
CleaveLeft = Replace[Flatten[{
{{x_.*((#)^(n_.)):>{#, x ((#)^(n-1))}, x_.*((Subscript[#, i_])^(n_.)):>{(Subscript[#, i]),x ((Subscript[#, i])^(n-1))}}& /@ PBWBasis},
x_:>{x,1} }]];
CleaveRight = Replace[Flatten[{
{{x_.*((#)^(n_.)):>{x ((#)^(n-1)),#}, x_.*((Subscript[#, i_])^(n_.)):>{x ((Subscript[#, i])^(n-1)),(Subscript[#, i])}}& /@ Reverse@PBWBasis},
x_:>{1,x} }]];

Unprotect[NonCommutativeMultiply];
0**_=_**0=0;
x_**1:=x; 1**x_:=x;
(x_Plus)**y_ := (#**y)& /@ x;
x_**(y_Plus) := (x**#)& /@ y;
x_ ** y_ /; ScalarQ[x]∨ScalarQ[y] := x*y;
x_**y_ /; AtomicQ[x]∧AtomicQ[y] := x*y+If[Type[x]<Type[y],0,b[x,y]];
x_ ** y_ /; AtomicQ[x]∧DecomposableQ[y] := (
CleaveLeft[y] /. {y1_,y2_} :> If[Type[x]≤Type[y1],x*y,(x**y1)**y2]);
x_**y_ /; DecomposableQ[x]:= (CleaveRight[x] /. {x1_,x2_} :> x1**(x2**y));

LBasis[n_Integer] := LBasis[Range[n]];
LBasis[S_] := Module[{i,j,k,l},SortBy[(# /. {ϵ->2,(Subscript[c, _])->2,(Subscript[u, _])->2,(Subscript[w, _])->2})&][
Union@Flatten[{{1,ϵ},
Table[{(Subscript[c, i]),(Subscript[u, i]),(Subscript[w, i]),ϵ (Subscript[c, i]),ϵ (Subscript[u, i]),ϵ (Subscript[w, i])}, {i,S}],
Table[{(Subscript[u, i])(Subscript[w, j]),ϵ (Subscript[u, i])(Subscript[w, j]),ϵ (Subscript[c, i])(Subscript[c, j]),ϵ (Subscript[c, i])(Subscript[u, j]),ϵ (Subscript[c, i])(Subscript[w, j])}, {i,S}, {j,S}],
Table[{ϵ (Subscript[c, i])(Subscript[u, j])(Subscript[w, k]),ϵ (Subscript[u, i])(Subscript[u, j])(Subscript[w, k]),ϵ (Subscript[u, i])(Subscript[w, j])(Subscript[w, k])}, {i,S}, {j,S},{k,S}],
Table[ϵ (Subscript[u, i])(Subscript[u, j])(Subscript[w, k])(Subscript[w, l]), {i,S}, {j,S},{k,S},{l,S}] }]
]]

(Subscript[a, i_,j_]):=(Subscript[b, i])(Subscript[c, j])-ϵ (Subscript[c, i])(Subscript[c, j])+(Subscript[u, i])(Subscript[w, j]);

(Subscript[R, 0])[___][y_]/;ScalarQ[y]:=y;
(Subscript[R, 0])[x___][y_Plus] := (Subscript[R, 0])[x] /@ y;
(Subscript[R, 0])[τ_,i_,j_][(Subscript[c, i_])] := (Subscript[c, i])-(((E^(-τ (Subscript[b, i]))) (-1+(E^(τ (Subscript[b, i])))) (Subscript[u, i]) (Subscript[w, j]))/(Subscript[b, i]))+(((E^(-τ (Subscript[b, i]))) ϵ (-1+(E^(τ (Subscript[b, i])))-τ (Subscript[b, i])) (Subscript[u, i]) (Subscript[w, j]))/(Subscript[b, i]^2))-(((E^(-τ (Subscript[b, i]))) ϵ (-1+(E^(τ (Subscript[b, i])))-τ (Subscript[b, i])) (Subscript[c, i]) (Subscript[u, i]) (Subscript[w, j]))/(Subscript[b, i]^2))+(((E^(-τ (Subscript[b, i]))) ϵ (-1+(E^(τ (Subscript[b, i])))-τ (Subscript[b, i])) (Subscript[c, j]) (Subscript[u, i]) (Subscript[w, j]))/(Subscript[b, i]^2))+(((E^(-2 τ (Subscript[b, i]))) ϵ (-1+(E^(2 τ (Subscript[b, i])))-2 (E^(τ (Subscript[b, i]))) τ (Subscript[b, i])) (Subscript[u, i]^2) (Subscript[w, j]^2))/(Subscript[b, i]^3));
(Subscript[R, 0])[τ_,i_,j_][(Subscript[c, j_])] := (Subscript[c, j])+(((E^(-τ (Subscript[b, i]))) (-1+(E^(τ (Subscript[b, i])))) (Subscript[u, i]) (Subscript[w, j]))/(Subscript[b, i]))-(((E^(-τ (Subscript[b, i]))) ϵ (-1+(E^(τ (Subscript[b, i])))-τ (Subscript[b, i])) (Subscript[u, i]) (Subscript[w, j]))/(Subscript[b, i]^2))+(((E^(-τ (Subscript[b, i]))) ϵ (-1+(E^(τ (Subscript[b, i])))-τ (Subscript[b, i])) (Subscript[c, i]) (Subscript[u, i]) (Subscript[w, j]))/(Subscript[b, i]^2))-(((E^(-τ (Subscript[b, i]))) ϵ (-1+(E^(τ (Subscript[b, i])))-τ (Subscript[b, i])) (Subscript[c, j]) (Subscript[u, i]) (Subscript[w, j]))/(Subscript[b, i]^2))-(((E^(-2 τ (Subscript[b, i]))) ϵ (-1+(E^(2 τ (Subscript[b, i])))-2 (E^(τ (Subscript[b, i]))) τ (Subscript[b, i])) (Subscript[u, i]^2) (Subscript[w, j]^2))/(Subscript[b, i]^3));
(Subscript[R, 0])[τ_,i_,j_][(Subscript[c, k_])] /; (k=!=i)∧(k=!=j):= (Subscript[c, k]);
(Subscript[R, 0])[τ_,i_,j_][(Subscript[u, i_])] :=(Subscript[u, i])-ϵ τ (Subscript[c, j]) (Subscript[u, i])-(((E^(-τ (Subscript[b, i]))) ϵ (1-(E^(τ (Subscript[b, i])))+(E^(τ (Subscript[b, i]))) τ (Subscript[b, i])) (Subscript[u, i]^2) (Subscript[w, j]))/(Subscript[b, i]^2));
(Subscript[R, 0])[τ_,i_,j_][(Subscript[u, j_])] := -(((-1+(E^(τ (Subscript[b, i])))) (Subscript[b, j]) (Subscript[u, i]))/(Subscript[b, i]))-((ϵ (1-(E^(τ (Subscript[b, i])))+(E^(τ (Subscript[b, i]))) τ (Subscript[b, i])) (Subscript[b, j]) (Subscript[u, i]))/(Subscript[b, i]^2))+((ϵ (1-(E^(τ (Subscript[b, i])))+(E^(τ (Subscript[b, i]))) τ (Subscript[b, i])) (Subscript[b, j]) (Subscript[c, i]) (Subscript[u, i]))/(Subscript[b, i]^2))+((ϵ (-2 (Subscript[b, i])+2 (E^(τ (Subscript[b, i]))) (Subscript[b, i])-(Subscript[b, j])+(E^(τ (Subscript[b, i]))) (Subscript[b, j])-τ (Subscript[b, i]) (Subscript[b, j])) (Subscript[c, j]) (Subscript[u, i]))/(Subscript[b, i]^2))+(E^(τ (Subscript[b, i]))) (Subscript[u, j])-(E^(τ (Subscript[b, i]))) ϵ τ (Subscript[c, i]) (Subscript[u, j])-(((E^(-τ (Subscript[b, i]))) ϵ (-(Subscript[b, i])+2 (E^(τ (Subscript[b, i]))) (Subscript[b, i])-(E^(2 τ (Subscript[b, i]))) (Subscript[b, i])+2 (E^(τ (Subscript[b, i]))) (Subscript[b, j])-2 (E^(2 τ (Subscript[b, i]))) (Subscript[b, j])+(E^(τ (Subscript[b, i]))) τ (Subscript[b, i]) (Subscript[b, j])+(E^(2 τ (Subscript[b, i]))) τ (Subscript[b, i]) (Subscript[b, j])) (Subscript[u, i]^2) (Subscript[w, j]))/(Subscript[b, i]^3))+((ϵ (1-(E^(τ (Subscript[b, i])))+(E^(τ (Subscript[b, i]))) τ (Subscript[b, i])) (Subscript[u, i]) (Subscript[u, j]) (Subscript[w, j]))/(Subscript[b, i]^2));
(Subscript[R, 0])[τ_,i_,j_][(Subscript[u, k_])] /; (k=!=i)∧(k=!=j):= (Subscript[u, k]);
(Subscript[R, 0])[τ_,i_,j_][(Subscript[w, i_])] := (Subscript[w, i])+ϵ τ (Subscript[c, j]) (Subscript[w, i])+(E^(-τ (Subscript[b, i]))) (-1+(E^(τ (Subscript[b, i])))) (Subscript[w, j])-(((E^(-τ (Subscript[b, i]))) ϵ (-1+(E^(τ (Subscript[b, i])))+τ (Subscript[b, i])) (Subscript[c, i]) (Subscript[w, j]))/(Subscript[b, i]))+(((E^(-τ (Subscript[b, i]))) ϵ (1-(E^(τ (Subscript[b, i])))+(E^(τ (Subscript[b, i]))) τ (Subscript[b, i])) (Subscript[c, j]) (Subscript[w, j]))/(Subscript[b, i]))+(((E^(-τ (Subscript[b, i]))) ϵ (1-(E^(τ (Subscript[b, i])))+(E^(τ (Subscript[b, i]))) τ (Subscript[b, i])) (Subscript[u, i]) (Subscript[w, i]) (Subscript[w, j]))/(Subscript[b, i]^2))+(((E^(-2 τ (Subscript[b, i]))) (1+(E^(τ (Subscript[b, i])))) ϵ (1-(E^(τ (Subscript[b, i])))+(E^(τ (Subscript[b, i]))) τ (Subscript[b, i])) (Subscript[u, i]) (Subscript[w, j]^2))/(Subscript[b, i]^2));
(Subscript[R, 0])[τ_,i_,j_][(Subscript[w, j_])] := (E^(-τ (Subscript[b, i]))) (Subscript[w, j])+(E^(-τ (Subscript[b, i]))) ϵ τ (Subscript[c, i]) (Subscript[w, j])-(((E^(-2 τ (Subscript[b, i]))) ϵ (1-(E^(τ (Subscript[b, i])))+(E^(τ (Subscript[b, i]))) τ (Subscript[b, i])) (Subscript[u, i]) (Subscript[w, j]^2))/(Subscript[b, i]^2));
(Subscript[R, 0])[τ_,i_,j_][(Subscript[w, k_])] /; (k=!=i)∧(k=!=j):= (Subscript[w, k]);
(Subscript[R, 0])[x___][y_] := CleaveLeft[y] /. {y1_,y2_} :> (Subscript[R, 0])[x][y1]**(Subscript[R, 0])[x][y2];
(Subscript[R, 0])[i_,j_] := (Subscript[R, 0])[-1,i,j];