Pensieve header: The Logos in the ucw order (user-responsibility degrees).

Implementing (Subscript[g, 1])

ϵ /: (ϵ^2)=0;
PBWRule={u->1,c->2,w->3};
B[U@c,U@w]=-(B[U@w,U@c]=U@w);
B[U@u,U@c]=-(B[U@c,U@u]=U@u);
B[U@w,U@u]=-(B[U@u,U@w]=b U[]-2ϵ U@c);

UU[l___,((x_)^(n_)),r___]:= UU[l,Sequence@@Table[x,{n}],r];
UU[l___,1,r___]:= UU[l,r];
UU[]=U[]; UU[l_,r___]:=U[l]**UU[r];(Subscript[U, i_])[ℰ_] := ℰ /. {b->(Subscript[b, i]), u_U :> Replace[u, x_ :> (Subscript[x, i]),1]};

B[x_,x_]=0;
B[U[(Subscript[(x_), i_])],U[(Subscript[(y_), i_])]]:=B[U[(Subscript[x, i])],U[(Subscript[y, i])]]=(Subscript[U, i])[B[U@x,U@y]];
B[U[(Subscript[(x_), i_])],U[(Subscript[(y_), j_])]] /; i=!=j := 0;
B[x_,y_] := x**y-y**x;

x_⪯y_:=OrderedQ[{x,y}/.PBWRule]; x_≺y_:=!OrderedQ[{y,x}/.PBWRule];
Simp[ℰ_]:= Collect[ℰ, _U, Expand];

Unprotect[NonCommutativeMultiply];
NonCommutativeMultiply[x_] := x;
0**_=_**0=0;
x_**U[]:=x; U[]**x_:=x;
(a_*x_U)**(b_*y_U) := If[a b === 0, 0, Simp[a b (x**y)]];
(a_*x_U)**y_ := Simp[a(x**y)]; x_**(a_*y_U) := Simp[a(x**y)];
(x_Plus)**y_ := (#**y)& /@ x; x_**(y_Plus) := (x**#)& /@ y;
U[x_]**U[y_] := If[x≺y, U[x,y], U[y,x]+B[U@x,U@y]];
U[x_] ** U[y1_,yy__] := If[x⪯y1,U[x,y1,yy],(U@x**U@y1)**U@yy];
U[xx__,xn_]**U[yy__] := U@xx**(U@xn**U@yy);

U[l___,((x_)^(n_)),r___]:= U[l,Sequence@@Table[x,{n}],r];
U[l___,1,r___]:= U[l,r];

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

UExp[ℰ_,n_]:=Module[{t=U[],k}, U[]+Sum[((t=t**ℰ)/(k!)), {k,n}]]//Simp

ToDegree[n_][ℰ_] := Simp[ℰ] /. a_.x_U :>Normal[Series[a,{ℏ,0,n}]]*x

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

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

𝕆[n_, poly_, specs___] := Module[{vs,us},
vs=Join@@(First /@ {specs});
us=Join@@({specs} /. (l_->s_) :> (l/.(Subscript[x_, i_]):>(Subscript[x, s])));
Total[
CoefficientRules[Normal@Series[poly, {ℏ,0,n}], vs] /. (p_->c_) :> c UU@@((us^p))
]
]

Testing (Subscript[g, 1])

Table[x->B[U@x,(Subscript[a, 1,2])], {x,{(Subscript[c, 1]),(Subscript[c, 2]),(Subscript[u, 1]),(Subscript[u, 2]),(Subscript[w, 1]),(Subscript[w, 2]),(Subscript[c, 3]),(Subscript[u, 3]),(Subscript[w, 3])}}] // Column

B[(Subscript[a, 1,3]),(Subscript[a, 2,3])]+B[(Subscript[a, 1,2]),(Subscript[a, 2,3])]+B[(Subscript[a, 1,2]),(Subscript[a, 1,3])]

{t1=B[(Subscript[a, 1,2]),(Subscript[a, 1,3])], t2=ϵ U@(Subscript[c, 3])**(Subscript[a, 1,2])-ϵ U@(Subscript[c, 2])**(Subscript[a, 1,3]), t1-t2} // Expand // Column

{t1=B[(Subscript[a, 1,3]),(Subscript[a, 2,3])], t2=(Subscript[bc, 2])**(Subscript[a, 1,3])-(Subscript[bc, 1])**(Subscript[a, 2,3]), t1-t2} // Expand // Column

{t1=(Subscript[a, 1,3])**(Subscript[a, 2,4])-(Subscript[a, 1,4])**(Subscript[a, 2,3]),
t2=(Subscript[a, 1,3])**(Subscript[bc, 2])**U@(Subscript[c, 4])-(Subscript[a, 2,3])**(Subscript[bc, 1])**U@(Subscript[c, 4])-(Subscript[a, 1,4])**(Subscript[bc, 2])**U@(Subscript[c, 3])+(Subscript[a, 2,4])**(Subscript[bc, 1])**U@(Subscript[c, 3]),
t1-t2
} // Column

LBasis[2]

bas=LBasis[2];Table[B[x,y]+B[y,x], {x,bas},{y,bas}] //Flatten//Union

bas=LBasis[2]; Timing[
Table[
{x,y,z}=xyz;
Simp[B[B[x,y],z]+B[B[y,z],x]+B[B[z,x],y]],
{xyz, Subsets[bas,{3}]}
] //Flatten//Union
]

Infinitesimal Spinner Relations

(Subscript[s, i_]):=((Subscript[b, i])/2)U[]-ϵ U[(Subscript[c, i])]

(Subscript[a, 1,2])

B[(Subscript[a, 1,2]),(Subscript[s, 1])]

B[(Subscript[a, 1,2]),(Subscript[s, 2])]

B[(Subscript[a, 1,2]),(Subscript[s, 1])+(Subscript[s, 2])]//Simplify

B[(Subscript[a, 1,3]),(Subscript[a, 2,3])]

Simplify[(Subscript[b, 1]) UU[(Subscript[u, 1]),(Subscript[w, 3])]-(Subscript[b, 1]) UU[(Subscript[u, 1]), (Subscript[w, 3])]+ϵ UU[(Subscript[c, 1]),(Subscript[u, 1]),(Subscript[w, 3])]-ϵ UU[(Subscript[u, 1]),(Subscript[c, 1]),(Subscript[w, 3])]]

Testing bi-local exponential relations in (Subscript[g, 0])

The Yang-Baxter Element.

c Relations.

B[U[c],U[u,w]]

𝕆[3, (E^(ℏ(γ (Subscript[c, 0])+β (Subscript[u, 0])))),{(Subscript[u, 0]),(Subscript[c, 0])}->1]

𝕆[3, (E^(ℏ(γ (Subscript[c, 0])+(E^(-ℏ γ))β (Subscript[u, 0])))),{(Subscript[c, 0]),(Subscript[u, 0])}->1]

With[{n=7}, Simp[𝕆[n, (E^(ℏ(γ (Subscript[c, 0])+β (Subscript[u, 0])))),{(Subscript[u, 0]),(Subscript[c, 0])}->0]==𝕆[n, (E^(ℏ(γ (Subscript[c, 0])+(E^(-ℏ γ))β (Subscript[u, 0])))),{(Subscript[c, 0]),(Subscript[u, 0])}->0]]]

With[{n=7}, Simp[𝕆[n, (E^(ℏ(γ (Subscript[c, 0])+ℏ β (Subscript[w, 0])))),{(Subscript[w, 0]),(Subscript[c, 0])}->0]==𝕆[n, (E^(ℏ(γ (Subscript[c, 0])+ℏ (E^(ℏ γ))β (Subscript[w, 0])))),{(Subscript[c, 0]),(Subscript[w, 0])}->0]]]

u,w,(e^u),(e^w).

With[{n=10},Simp[B[U@w,UExp[γ U@u,n]] + (b γ U[]-2γ ϵ U[c]+ϵ (γ^2)U[u])** UExp[γ U@u,n]]]

With[{n=7},Simp[B[U@u,UExp[γ U@w,n]] - (b γ U[]-2γ ϵ U[c]-ϵ (γ^2)U[w])** UExp[γ U@w,n]]]

(Subscript[M, uw]) Relations.

Muw[γ_,n_] := Expand[(∑_(k=0)^n)((γ^k)/(k!))UU[(u^k),(w^k)]]

Muw[γ,5]

𝕆[5,(E^(ℏ δ (Subscript[u, 0])(Subscript[w, 0]))), {(Subscript[u, 0]),(Subscript[w, 0])}->1]

With[{n=12},Muw[γ,n]**U[u]-Expand@((1-b γ-2 γ ϵ )U[u]+2 γ ϵ UU[c,u]-(((1-b γ))^(-1))(γ^2) ϵ U[u,u,w])**Muw[γ,n]] // Simplify // Expand

With[{n=7}, Simplify[B[U[w],Muw[γ,n]]+b γ Muw[γ,n]**U[w]]]

With[{n=7}, Simplify[
((∂_α)Muw[γ[α],n])-((γ'[α])/(1-b γ[α]))Muw[γ[α],n]**U[u,w]
]]

Λ=With[{vs={1,ℏ (Subscript[u, 0]),(Subscript[w, 0]),(ℏ^2)(Subscript[u, 0]^2),(Subscript[w, 0]^2),(ℏ^2)(Subscript[u, 0]^2)(Subscript[w, 0]),ℏ (Subscript[u, 0])(Subscript[w, 0]^2),(ℏ^2)(Subscript[u, 0]^2)(Subscript[w, 0]^2),(Subscript[c, 0]),ℏ (Subscript[c, 0])(Subscript[u, 0]),(Subscript[c, 0])(Subscript[w, 0]),ℏ (Subscript[c, 0])(Subscript[u, 0])(Subscript[w, 0]),ℏ (Subscript[u, 0])(Subscript[w, 0])}},
Table[(Subscript[a, i]),{i,Length@vs}].vs
] /. {
(Subscript[a, 1])->0(Subscript[a, 1])-(μ^(-1))ℏ (Subscript[b, 1])(δ^2)-2(μ^(-2))α β δ (ℏ^2)(Subscript[b, 1])-(1/2) (μ^(-3))(α^2) (β^2) (ℏ^3) (Subscript[b, 1]),
(Subscript[a, 2])->0(Subscript[a, 2])+2(μ^(-2))β δ+(μ^(-3))α (β^2)ℏ,
(Subscript[a, 3])->0(Subscript[a, 3])+2(μ^(-2))α δ ℏ+(μ^(-3))(α^2) β (ℏ^2),
(Subscript[a, 4])->0(Subscript[a, 4])+(β^2)δ (μ^(-3))(1+ℏ (Subscript[b, 1])δ/2),
(Subscript[a, 5])->0(Subscript[a, 5])+(ℏ^2)(α^2)δ (μ^(-3))(1+ℏ (Subscript[b, 1])δ/2),
(Subscript[a, 6])->0(Subscript[a, 6])+3β (δ^2)(μ^(-3))(1+(2/3) ℏ (Subscript[b, 1])δ),
(Subscript[a, 7])->0(Subscript[a, 7])+3 α (δ^2) ℏ(μ^(-3))(1+(2/3) ℏ (Subscript[b, 1])δ),
(Subscript[a, 8])->0(Subscript[a, 8])+2(δ^3)(μ^(-3))(1+(3/4) ℏ (Subscript[b, 1])δ),
(Subscript[a, 9])->0(Subscript[a, 9])+2δ+2(μ^(-1))α β ℏ,
(Subscript[a, 10])->0(Subscript[a, 10])+2β δ (μ^(-1)),
(Subscript[a, 11])->0(Subscript[a, 11])+2α δ ℏ (μ^(-1)),
(Subscript[a, 12])->0(Subscript[a, 12])+2(δ^2)(μ^(-1)),
(Subscript[a, 13])->0(Subscript[a, 13])+4(δ^2)(μ^(-2))(1+(1/2) ℏ (Subscript[b, 1])δ)+4ℏ α β δ (μ^(-3))(1+(1/2) ℏ (Subscript[b, 1])δ)
};
With[{n=8},Simp[
𝕆[n,(E^(ℏ(α (Subscript[w, 0])+β (Subscript[u, 0])+δ (Subscript[u, 0])(Subscript[w, 0])))),{(Subscript[w, 0]),(Subscript[u, 0])}->1]-𝕆[n,(μ^(-1))(1+ℏ ϵ (μ^(-1))Λ)(E^(ℏ(-ℏ (Subscript[b, 1])α β+α (Subscript[w, 0])+β (Subscript[u, 0])+δ (Subscript[u, 0])(Subscript[w, 0]))/μ))/. μ->1+ℏ (Subscript[b, 1])δ,{(Subscript[u, 0]),(Subscript[c, 0]),(Subscript[w, 0])}->1]
]]

Simplify[Λ/.{ℏ->1,(Subscript[b, 1])->b,(Subscript[u, 0])->u,(Subscript[w, 0])->w,(Subscript[c, 0])->c}]

(Collect[Simplify[(μ^3)Λ/.{ℏ->1,(Subscript[b, 1])->b,(Subscript[u, 0])->u,(Subscript[w, 0])->w,(Subscript[c, 0])->c}], {c,u,w}, C[Simplify[#]]&]//Expand)/.C[x_]:>x

oldΛ=2 c w α δ ν+2 c u β δ ν+2 c u w (δ^2) ν+u (w^2) α (δ^2) (ν^3)-(1/2) b (u^2) (w^2) (δ^4) (ν^3)+(1/2) (w^2) (α^2) δ (2+b δ) (ν^3)-(u^2) w β (δ^2) (1+2 b δ) (ν^3)-(1/2) (u^2) (β^2) δ (2+3 b δ) (ν^3)+2 c (δ+α β ν)-2 b u w (δ^2) (ν^2) (δ+α β ν)+w α (ν^2) (2 δ+α β ν)-u β (1+2 b δ) (ν^2) (2 δ+α β ν)-(1/2) b ν (2 (δ^2)+4 α β δ ν+(α^2) (β^2) (ν^2))

Rescaling the logos as in Projects/OneCo-1606/RescalingTheLogos.nb:

nlogos=With[{ζ=(b/(t-1)),logos=(ϵ/(2 (μ^3)))(-b (α^2) (β^2)+(u^2) (β^2) δ (2+b δ)+(w^2) δ (α+u δ) (α (2+b δ)+u δ (4+3 b δ))-4 b α β δ μ+4 c α β (μ^2)-2 b (δ^2) (μ^2)+4 c δ (μ^3)+2 u β (α β+2 δ μ (1+c μ))+2 w ((α^2) β+2 α δ (u β (2+b δ)+μ (1+c μ))+u (δ^2) (u β (3+2 b δ)+2 μ (2+b δ+c μ))))}, logos /. μ->1+b δ /. {ϵ->ζ ϵ,u->ζ u,β->(ζ^(-1))β,δ->(ζ^(-1))δ}];
(Collect[Simplify[(((1+(-1+t) δ))^3)nlogos/ϵ], {c,u,w}, C[Simplify[#]]&]//Expand)/.C[x_]:>x