Pensieve header: One-Co computations; continues pensieve://2015-05/.

The bracket

In the basis {a[f,i,j], γ[f,i,j], γ[f,i,j,k], γa[f,i,j,k,l]}.

Generalities

CF[expr_] := expr /. {
a[f_,i_,j_] :> Interpretation[StringForm["a[``,````]",f,i,j], a[f,i,j]],
γ[f_,i_,j_] :> Interpretation[StringForm["γ[``,````]",f,i,j], γ[f,i,j]],
γ[f_,i_,j_,k_] :> Interpretation[StringForm["γ[``,``````]",f,i,j,k], γ[f,i,j,k]],
γa[f_,i_,j_,k_,l_] :> Interpretation[StringForm["γa[``,````````]",f,i,j,k,l], γa[f,i,j,k,l]]
}

DQ[is___] := (Sort[{is}]===Union[{is}]);

Simp[expr_] := Simplify[expr];
S[γ[f_,j_,k_,k_]] = 0;
S[γ[f_,j_,k_,l_]] /; OrderedQ[{l,k}]∧DQ[k,l] := γ[-f, j, l, k] // S;
S[γa[f_, i_,j_,i_,k_]] /; OrderedQ[{k,j}]∧DQ[k,j] := γ[(Subscript[b, i])f, i,j,k] + γa[f, i,k,i,j] // S;
(*S[γa[f_,i_,j_,k_,l_]] /; (DQ[i,j,k,l]∧(OrderedQ[{i,j,k,l}]∨OrderedQ[{i,k,j,l}]∨OrderedQ[{i,l,j,k}])) :=
γ[(Subscript[b, k])f,i,j,l]-γ[(Subscript[b, i])f,k,j,l]-γa[f,k,l,i,j]+γa[f,i,l,k,j]+γa[f,k,j,i,l];*)
S[β[f_]] := β[Simp[f]];
S[a[i_,j_]] := a[i,j];
S[a[f_, i_,j_]] := a[Simp[f], i,j];
S[γ[f_, is__]] := γ[Simp[f], is];
S[γa[f_, is__]] := γa[Simp[f], is];
S[expr_] := expr /. (λ_β|λ_a|λ_γ|λ_γa) :> S[λ];

S[γa[f_,i_,j_,k_,l_]] /; DQ[i,j,k,l]∧OrderedQ[{l,j}] := -γ[(Subscript[b, k])f,i,l,j]+γa[f,i,l,k,j];

β[0] :=0;
β /: β[f_] + β[g_] := β[f+g];
β /: -β[f_] := β[-f] // S;
a[0,__] := 0;
a /: a[f_,i_,j_] + a[g_, i_,j_] := a[f+g, i,j];
a /: -a[f_, is__] := a[-f, is] // S;
γ[0,__] :=0;
γ /: γ[f_,is__] + γ[g_, is__] := γ[f+g, is];
γ /: -γ[f_, is__] := γ[-f, is] // S;
γa[0,__] :=0;
γa /: γa[f_,is__] + γa[g_, is__] := γa[f+g, is];
γa /: -γa[f_, is__] := γa[-f, is] // S;

B[0,_] =0; B[_, 0] = 0;
B[x_,x_] = 0;
B[x_Plus, y_] := B[#,y]& /@ x;
B[x_, y_Plus] := B[x,#]& /@ y;

Specific Brackets

Generalities:

B[a[j_,k_], a[i_,j_]] /; DQ[i,j,k] := -B[a[i,j], a[j,k]];
B[a[f_, j_,k_], a[g_, l_,m_]] := Plus[
B[a[j,k], a[l,m]] /. {a[h_,is__] :> a[f g h, is], γ[h_,is__] :> γ[f g h, is]},
γa[f((∂_(Subscript[b, j]))g-(∂_(Subscript[b, k]))g), j,k,l,m] + γa[g((∂_(Subscript[b, m]))f-(∂_(Subscript[b, l]))f), l,m,j,k]
] // S;

Vanishing brackets:

B[a[j_,k_],a[l_,m_]] /; DQ[j,k,l,m] := 0;
B[a[f_,j_,k_],γ[g_,l_,m_]] /; DQ[j,k,l,m] := 0;
B[a[f_,j_,k_],γ[g_,j_,l_]] /; DQ[j,k,l] := 0;
B[a[f_,j_,k_],γ[g_,j_,l_,m_]] /; DQ[j,k,l,m] := 0;
B[a[f_,i_,j_],γ[g_,k_,l_,m_]] /; DQ[i,j,k,l,m] := 0;

Non-vanishing brackets:

B[a[f_,j_,k_],β[g_]]:=γ[f((∂_(Subscript[b, j]))g-(∂_(Subscript[b, k]))g),j,k] // S;
B[a[j_,k_],a[j_,l_]]/;DQ[j,k,l]:=γ[1,j,k,l] // S;
B[a[j_,k_],a[i_,k_]]/;DQ[i,j,k]:=S[a[(Subscript[b, i]),j,k]-a[(Subscript[b, j]),i,k]];
B[a[j_,k_],a[k_,l_]]/;DQ[j,k,l]:=S[a[(Subscript[b, j]),k,l]-a[(Subscript[b, k]),j,l]-γ[1,j,k,l]];
B[a[f_,j_,k_],γ[g_,i_,k_]]/;DQ[i,j,k]:=S@ γ[-(Subscript[b, j])f g,i,k];
B[a[f_,j_,k_],γ[g_,i_,j_]]/;DQ[i,j,k]:=S@γ[(Subscript[b, j])f g,i,k];
B[a[f_,j_,k_],γ[g_,k_,l_]]/;DQ[j,k,l]:=S[γ[(Subscript[b, j])f g,k,l]-γ[(Subscript[b, k])f g,j,l]];
B[a[f_,j_,k_],γ[g_,j_,k_]]:= γ[-(Subscript[b, j])f g,j,k] // S;
B[a[f_,j_,k_],γ[g_,i_,j_,l_]]/;DQ[i,j,k,l]:=γ[(Subscript[b, j])f g,i,k,l]+γa[f g,i,l,j,k] // S;
B[a[f_,l_,k_],γ[g_,i_,j_,l_]]/;DQ[i,j,k,l]:=γ[-(Subscript[b, l])f g,i,k,j]+γa[-f g,i,j,l,k] // S;
B[a[f_,j_,k_],γ[g_,k_,l_,m_]]/;DQ[j,k,l,m]:=γ[-(Subscript[b, k])f g,j,l,m]+γ[(Subscript[b, j])f g,k,l,m] // S;
B[a[f_,j_,k_],γ[g_,n_,i_,k_]]/;DQ[n,i,j,k]:=γ[-(Subscript[b, j])f g,n,i,k]+γa[f g,n,i,j,k] // S;
B[a[f_,j_,i_],γ[g_,n_,i_,k_]]/;DQ[n,i,j,k]:=γ[(Subscript[b, j])f g,n,k,i]+γa[-f g,n,k,j,i] // S;
B[a[f_,j_,k_],γ[g_,j_,k_,l_]]/;DQ[j,k,l]:=S@γa[-f g,j,k,j,l];
B[a[f_,j_,l_],γ[g_,j_,k_,l_]]/;DQ[j,k,l]:=S@γa[f g,j,l,j,k];
B[a[f_,j_,k_],γ[g_,i_,j_,k_]]/;DQ[i,j,k]:=S[γ[-(Subscript[b, j])f g,i,j,k]+γa[f g,i,j,j,k]+γa[f g,i,k,j,k]];
B[a[f_,k_,j_],γ[g_,i_,j_,k_]]/;DQ[i,j,k]:=S[γ[(Subscript[b, k])f g,i,k,j]+γa[-f g,i,k,k,j]+γa[-f g,i,j,k,j]];

[a,γa] brackets:

B[x_a, γa[f_, i_,j_,m_,n_]] := Plus[
B[x, γ[f, i,j]] /. γ[g_, k_,l_] :> γa[g, k,l,m,n],
B[x, a[1, m,n]] /. {a[g_, k_,l_] :> γa[f g, i,j,k,l], _γ|_γa:>0}
] // S

[β,a], [γ,a], [γ,γ] brackets:

B[x_β|x_γ|x_γa, y_a] := -B[y,x];
B[_β|_γ|_γa, _β|_γ|_γa] := 0;

tests={β[f[(Subscript[b, j]),(Subscript[b, k])]], γ[1,i,j], γ[1,i,k],  γ[1,i,l], γ[1,j,k], γ[1,j,l],  γ[1,k,l], γ[1,j,l,m], γ[1,i,j,l], γ[1,i,k,l], γ[1, k,l,m], γ[1,j,k,l], γ[1,i,j,k], a[1,j,k], a[1,j,l], a[1,i,k], a[1,i,j], a[1,k,l], a[1,l,m], γa[1,j,k,j,l]};
shows=Complement[tests, {γ[1,i,l], γ[1,j,l],γ[1,j,l,m],a[1,j,k],a[1,l,m]}];

ColumnForm[(#->B[a[1,j,k],#])& /@ shows] // CF

Testing Jacobi and Anti-Symmetry

t1=B[a[1,1,2],γ[(Subscript[b, 2]),2,3,4]]

t2=B[a[1,1,2],γa[1,2,3,2,4]]

t3=B[a[1,1,2],γa[1,2,4,2,3]]

t1-t2+t3

FormalPlusBasis[n_, f_] := Module[{ff},
ff=f@@Table[(Subscript[b, i]), {i,n}];
Flatten@{
Table[a[ff, i,j], {i,n-1}, {j,i+1,n}],
Table[γ[ff, i,j], {i,n-1}, {j,i+1,n}],
Table[γ[ff, i,j,k], {i,n-2}, {j,i+1,n-1}, {k,j+1,n}],
Table[γa[ff, i,j,k,l], {i,n-1},{j,i+1,n},{k,n-1},{l,k+1,n}]
} /. 1[___] -> 1
];

FormalPlusBasis[3, f]

AS[x1_,x2_] := Module[{as},
as=B[x1,x2]+B[x2,x1] // S;
If[as===0,as,{x1,x2} ->  as]
];
Outer[
AS,
FormalPlusBasis[3,f],
FormalPlusBasis[3,g]
]

Jacobi[x1_,x2_,x3_] := Module[{Jac},
Jac=S[B[x1,B[x2,x3]] + B[x2,B[x3,x1]] + B[x3,B[x1,x2]]];
If[Jac===0,Jac,{x1,x2,x3} ->  Jac]
];

JacErrors=DeleteCases[
bas1=FormalPlusBasis[4,f];
bas2=FormalPlusBasis[4,g];
bas3=FormalPlusBasis[4,h];
Flatten[
Table[Jacobi[bas1[[i]],bas2[[j]],bas3[[k]]],
{i,Length[bas1]-1}, {j, i+1,Length@bas2}, {k,i+1,Length@bas3}]
],
0]

DeleteCases[
Flatten[Outer[
Jacobi,
FormalPlusBasis[4,f],
FormalPlusBasis[4,g],
FormalPlusBasis[4,h]
]],
0]

Testing representations

The R⟨(Subscript[βγ, 2])⟩ representation

Outer[
Function[{x,y,r}, {x,y,r} -> S[B[B[x,y],r]-B[x,B[y,r]]+B[y,B[x,r]]]],
{a[1, 1,2], a[1, 1,3], a[1, 2,3]},
{a[1, 1,2], a[1, 1,3], a[1, 2,3]},
{β[f[(Subscript[b, 1]),(Subscript[b, 2]),(Subscript[b, 3])]]}
] // Flatten // ColumnForm

The Adjoint action

AutoAd[x_][y_] := Module[{pows, states, s, seq,sh=5, sf, t1, n},
pows = NestList[B[x,#]&, y, 15];
states = Union[Cases[pows, s_a|s_β|s_γ|s_γa :> ReplacePart[s, 1->_], ∞]];
Sum[
seq=Cases[{#},s, ∞]& /@ pows;
seq=Replace[seq,{{_[f_,___]}:>f, {}->0}, {1}];
sf=FindSequenceFunction[Drop[seq, sh]];
ReplacePart[s, 1 ->FullSimplify[ (∑_(n=0)^(sh-1))((seq[[n+1]])/(n!))+ (∑_(n=sh)^∞)((sf[n+1-sh])/(n!))]],
{s,states}]
];
AutoAd1[x_][y_] := Module[{pows, states, s, seq,sh, sf, t1, n},
pows = NestList[B[x,#]&, y, 15];
states = Union[Cases[pows, s_a|s_β|s_γ|s_γa :> ReplacePart[s, 1->_], ∞]];
Sum[
seq=Cases[{#},s, ∞]& /@ pows;
sh=0; While[seq[[1]]==={}, ++sh; seq=Rest[seq]];
seq=Replace[seq,{{_[f_,___]}:>f, {}->0}, {1}];
sf=Replace[seq,{
{t1_,0...}:>(t1*KroneckerDelta[1,#]&),
seq_ :> FindSequenceFunction[seq]
}];
ReplacePart[s, 1 ->FullSimplify[ (∑_(n=sh)^∞)((sf[n+1-sh])/(n!))]],
{s,states}
]
]
(* Hint: Perhaps improve using Variables, CoefficientList, FromCoefficientList *)

Ad[a[t_,j_,k_]][β[f_]] /; FreeQ[t,(Subscript[b, _])] := β[f]+γ[((((E^(-t (Subscript[b, j])))-1) ((∂_(Subscript[b, k]))f-(∂_(Subscript[b, j]))f))/(Subscript[b, j])),j,k];
Ad[a[t_,j_,k_]][γ[f_, j_,k_]] /; FreeQ[t,(Subscript[b, _])] := γ[(E^(-t (Subscript[b, j])))f,j,k];
Ad[a[t_,j_,k_]][γ[f_, j_,l_]] /; DQ[j,k,l]∧FreeQ[t,(Subscript[b, _])] := γ[f,j,l];
Ad[a[t_,j_,k_]][γ[f_, i_,k_]] /; DQ[i,j,k]∧FreeQ[t,(Subscript[b, _])] := γ[(E^(-t (Subscript[b, j]))) f,i,k];
Ad[a[t_,j_,k_]][γ[f_, i_,j_]] /; DQ[i,j,k]∧FreeQ[t,(Subscript[b, _])] := γ[f,i,j]+γ[f-(E^(-t (Subscript[b, j]))) f,i,k];
Ad[a[t_,j_,k_]][γ[f_, k_,l_]] /; DQ[j,k,l]∧FreeQ[t,(Subscript[b, _])] := γ[(E^(t (Subscript[b, j]))) f,k,l]+γ[(((1-(E^(t (Subscript[b, j])))) f (Subscript[b, k]))/(Subscript[b, j])),j,l];
Ad[a[t_,j_,k_]][γ[f_, i_,l_]] /; DQ[i,j,k,l]∧FreeQ[t,(Subscript[b, _])] := γ[f,i,l];
Ad[a[t_,j_,k_]][γ[f_, j_,l_,m_]] /; DQ[j,l,k,m]∧FreeQ[t,(Subscript[b, _])] := γ[f, j,l,m];
Ad[a[t_,j_,k_]][γ[f_, i_,j_,l_]] /; DQ[i,j,k,l]∧FreeQ[t,(Subscript[b, _])] :=  γ[f,i,j,l]+γ[f-(E^(-t (Subscript[b, j]))) f,i,k,l]+γa[((f-(E^(-t (Subscript[b, j]))) f)/(Subscript[b, j])),i,l,j,k];
Ad[a[t_,j_,k_]][γ[f_, i_,k_,l_]] /; DQ[i,j,k,l]∧FreeQ[t,(Subscript[b, _])] :=  γ[(E^(-t (Subscript[b, j]))) f,i,k,l]+γa[((((E^(-t (Subscript[b, j])))-1) f)/(Subscript[b, j])),i,l,j,k];
Ad[a[t_,j_,k_]][γ[f_, k_,l_,m_]] /; DQ[j,k,l,m]∧FreeQ[t,(Subscript[b, _])] := γ[(E^(t (Subscript[b, j]))) f,k,l,m]+γ[(((1-(E^(t (Subscript[b, j])))) f (Subscript[b, k]))/(Subscript[b, j])),j,l,m];
Ad[a[t_,j_,k_]][γ[f_, j_,k_,l_]] /; DQ[j,k,l]∧FreeQ[t,(Subscript[b, _])] := γ[f,j,k,l]+γa[(((-1+(E^(-t (Subscript[b, j])))) f)/(Subscript[b, j])),j,k,j,l];
Ad[a[t_,j_,k_]][γ[f_, i_,j_,k_]] /; DQ[i,j,k]∧FreeQ[t,(Subscript[b, _])] := γ[(E^(-t (Subscript[b, j]))) f,i,j,k]+γa[((1-(E^(-t (Subscript[b, j]))))/(Subscript[b, j]))f,i,j,j,k]+γa[((1-(E^(-t (Subscript[b, j]))))/(Subscript[b, j]))f,i,k,j,k];
Ad[a[t_,j_,k_]][a[1,j_,k_]] /; FreeQ[t,(Subscript[b, _])] := a[1,j,k];

Ad[a[t_,j_,k_]][a[1,j_,l_]] /; DQ[j,k,l]∧FreeQ[t,(Subscript[b, _])] := a[1,j,l]+γ[t,j,k,l]+γa[((1-(E^(-t (Subscript[b, j])))-t (Subscript[b, j]))/(Subscript[b, j]^2)),j,k,j,l];Ad[a[t_,j_,k_]][a[1,i_,k_]] /; DQ[i,j,k]∧FreeQ[t,(Subscript[b, _])] := a[(E^(-t (Subscript[b, j]))),i,k]+a[(((1-(E^(-t (Subscript[b, j])))) (Subscript[b, i]))/(Subscript[b, j])),j,k]+γa[(((E^(-2 t (Subscript[b, j]))) (Subscript[b, i]) (2 (E^(t (Subscript[b, j]))) t (Subscript[b, j])+1-(E^(2 t (Subscript[b, j])))))/(Subscript[b, j]^3)),j,k,j,k]+γa[(((E^(-2 t (Subscript[b, j]))) ((E^(t (Subscript[b, j]))) (1-t (Subscript[b, j]))-1))/(Subscript[b, j]^2)),j,k,i,k];
Ad[a[t_,j_,k_]][a[1,i_,j_]] /; DQ[i,j,k]∧FreeQ[t,(Subscript[b, _])] := a[1,i,j]+a[1-(E^(-t (Subscript[b, j]))),i,k]+a[((((E^(-t (Subscript[b, j])))-1) (Subscript[b, i]))/(Subscript[b, j])),j,k]+γ[((1-(E^(-t (Subscript[b, j]))))/(Subscript[b, j])),i,j,k]+γa[(((Subscript[b, i]) (1-2 (E^(-t (Subscript[b, j]))) t (Subscript[b, j])-(E^(-2 t (Subscript[b, j])))))/(Subscript[b, j]^3)),j,k,j,k]+γa[(((E^(-t (Subscript[b, j])))+t (Subscript[b, j])-1)/(Subscript[b, j]^2)),i,j,j,k]+γa[(((E^(-t (Subscript[b, j])))+t (Subscript[b, j])-1)/(Subscript[b, j]^2)),i,k,j,k]+γa[(((E^(-2 t (Subscript[b, j]))) (1+(E^(t (Subscript[b, j]))) (-1+t (Subscript[b, j]))))/(Subscript[b, j]^2)),j,k,i,k];
Ad[a[t_,j_,k_]][a[1,k_,l_]] /; DQ[j,k,l]∧FreeQ[t,(Subscript[b, _])] := a[(E^(t (Subscript[b, j]))),k,l]+a[(((1-(E^(t (Subscript[b, j])))) (Subscript[b, k]))/(Subscript[b, j])),j,l]+γ[((t (Subscript[b, j]) (Subscript[b, k])+(1-(E^(t (Subscript[b, j]))) )((Subscript[b, j])+(Subscript[b, k])))/(Subscript[b, j]^2)),j,k,l]+γa[((1+(E^(t (Subscript[b, j]))) (t (Subscript[b, j])-1))/(Subscript[b, j]^2)),j,k,k,l]+γa[(((E^(-t (Subscript[b, j])))(Subscript[b, j])+(E^(t (Subscript[b, j]))) ((Subscript[b, j])+2 (Subscript[b, k])-t (Subscript[b, j]) (Subscript[b, k]))-2 (Subscript[b, j])-2 (Subscript[b, k])-t (Subscript[b, j]) (Subscript[b, k]))/(Subscript[b, j]^3)),j,k,j,l];
Ad[a[t_,j_,k_]][a[1,l_,m_]] /; DQ[j,k,l,m]∧FreeQ[t,(Subscript[b, _])] := a[1,l,m];
(*Ad[β[f_]][a[1, i_,j_]] := a[1,i,j]+γ[(∂_(Subscript[b, j]))f-(∂_(Subscript[b, i]))f,i,j];*)
Ad[x_β|x_γ|x_γa][y_] := y+B[x,y];
Ad[β[f_]][t_β|t_γ|t_γa] := t;

AdTests[a[t,j,k]] = {β[f[(Subscript[b, j]),(Subscript[b, k])]], γ[f,i,j], γ[f,i,k], γ[f,j,l], γ[f,k,l], γ[f,i,j,l], γ[f,j,k,l], γ[f,i,j,k], γ[f,i,k,l], γ[f,k,l,m], a[1,j,k], a[1,j,l], a[1,i,k], a[1,i,j], a[1,k,l]};

S[AutoAd[a[t,j,k]][#]-Ad[a[t,j,k]][#]]& /@ AdTests[a[t,j,k]]

AutoAd[β[f[(Subscript[b, i]),(Subscript[b, j])]]][a[g, i,j]]- Ad[β[f[(Subscript[b, i]),(Subscript[b, j])]]][a[g, i,j]] // S

Ad[x_][y_Plus] := Ad[x] /@ y;
(Ad[x_][a[f_ ,i_,j_]] /; f=!=1 ):= Module[{Adf, g, γs},
Adf = β[f] // Ad[x];
Adf /. β[h_] :> (g=h);
γs = Cases[{Adf-β[g]}, _γ, ∞];
S[(a[1, i,j] // Ad[x]) /. {
a[h_, k_,l_] :> Plus[
a[g*h, k, l],
Total[γs /. γ[hh_, m_,n_] :> γa[h*hh, m,n,k,l]]
],
γ[h_,is__] :> γ[g*h, is],
γa[h_,is__] :> γa[g*h, is]
}]
];
Ad[x_][γa[f_, i_,j_,k_,l_]] := S[
Expand[(γ[f, i,j]//Ad[x])(a[1, k,l]//Ad[x])] /. {
γ[g_, m_,n_]a[h_,p_,q_] :> γa[g*h, m,n,p,q],
_γ*(_γ|_γa) -> 0
}
];

Ad[x_][y_] := (Print["Ad not yet defined on ", {x,y}]; y);

Print[CF[#->Ad[a[t,j,k]][#]]]& /@ shows;

The semi group properties

Module[{t1,t2},
t1=Ad[a[t,j,k]][#] /. (h:(a|β|γ|γa))[c_,r___] :> h[SeriesCoefficient[c,{t,0,1}],r];
t2=B[a[1,j,k], #];
# -> S[t1==t2]]& /@ tests // ColumnForm

Module[{t1,t2},
t1=Ad[β[t f[(Subscript[b, i]),(Subscript[b, j]),(Subscript[b, k])]]][#] /. (h:(a|β|γ|γa))[c_,r___] :> h[SeriesCoefficient[c,{t,0,1}],r];
t2=B[β[f[(Subscript[b, i]),(Subscript[b, j]),(Subscript[b, k])]], #];
# -> S[t1==t2]]& /@ {a[g[(Subscript[b, i]),(Subscript[b, j]),(Subscript[b, k])], i,j]} // ColumnForm

Module[{t1,t2},
t1=# // Ad[a[t,j,k]] // Ad[a[s,j,k]];
t2=# // Ad[a[t+s,j,k]];
# -> t1-t2 // S]& /@ tests // ColumnForm

((1-(E^(-s (Subscript[b, j]))))/(Subscript[b, j]))+(((E^(-t (Subscript[b, j]))) (-1+(E^(-s (Subscript[b, j])))))/(Subscript[b, j]))+(((-1+(E^(-s (Subscript[b, j])))) (1-(E^(-t (Subscript[b, j])))))/(Subscript[b, j]))// FullSimplify

Module[{t1,t2},
t1=# // Ad[β[t f[(Subscript[b, i]),(Subscript[b, j]),(Subscript[b, k])]]] // Ad[β[s f[(Subscript[b, i]),(Subscript[b, j]),(Subscript[b, k])]]];
t2=# // Ad[β[(t+s) f[(Subscript[b, i]),(Subscript[b, j]),(Subscript[b, k])]]];
# -> t1-t2 // S]& /@ {a[g[(Subscript[b, i]),(Subscript[b, j]),(Subscript[b, k])], i,j]} // ColumnForm

R

Switch[7,
0, R[i_,j_][x_] := Ad[a[1,i,j]][x],
1, R[i_,j_][x_] := Ad[a[1,i,j]][x] + B[a[t (Subscript[b, i]),i,j], Ad[a[1,i,j]][x]],
2, R[i_,j_][x_] := Ad[a[1,i,j]][x] + B[γ[t,i,j], Ad[a[1,i,j]][x]],
3, R[i_,j_][x_] := x // Ad[a[1,i,j]] // Ad[β[r[(Subscript[b, i]),(Subscript[b, j])]]],
4, R[i_,j_][x_] := x // Ad[a[1,i,j]] // Ad[β[f0[(Subscript[b, j])]+(Subscript[b, i])f1[(Subscript[b, j])]]],
5, R[i_,j_][x_] := x // Ad[a[1,i,j]] // Ad[β[f0[(Subscript[b, j])]+(Subscript[b, i])f1[(Subscript[b, j])]]] // Ad[γ[g, i,j]],
6, R[i_,j_][x_] := x // Ad[a[1,i,j]] // Ad[β[f0[(Subscript[b, j])]+(Subscript[b, i])f1[(Subscript[b, j])]]] // Ad[γ[g[(Subscript[b, i]),(Subscript[b, j])], i,j]] // Ad[γa[-(((E^(-(Subscript[b, i]))) (2-2 (E^(Subscript[b, i]))+(Subscript[b, i])+(E^(Subscript[b, i])) (Subscript[b, i])))/(2 (Subscript[b, i]^3))), i,j,i,j]],
7, R[i_,j_][x_] := x // Ad[a[1,i,j]] // Ad[γa[-(((E^(-(Subscript[b, i]))) (2-2 (E^(Subscript[b, i]))+(Subscript[b, i])+(E^(Subscript[b, i])) (Subscript[b, i])))/(2 (Subscript[b, i]^3))), i,j,i,j]]
];
VerifyR3[expr_] := Module[{lhs,rhs}, {
lhs = expr // R[1,2] // R[1,3] // R[2,3] // S;
rhs = expr // R[2,3] // R[1,3] // R[1,2] // S;
S[lhs-rhs]==0
}]

Verifying R3

VerifyR3 /@ {γ[f,1,4], γ[f,2,4], γ[f,3,4], γ[f,4,1], γ[f,4,2], γ[f,4,3]}

VerifyR3 /@ {a[f[(Subscript[b, 1]),(Subscript[b, 2]),(Subscript[b, 3]),(Subscript[b, 4])],1,4], a[f,2,4]}

VerifyR3 /@ {a[f[(Subscript[b, 1]),(Subscript[b, 2]),(Subscript[b, 3]),(Subscript[b, 4])],1,4], a[f[(Subscript[b, 1]),(Subscript[b, 2]),(Subscript[b, 3]),(Subscript[b, 4])],2,4], a[f[(Subscript[b, 1]),(Subscript[b, 2]),(Subscript[b, 3]),(Subscript[b, 4])],3,4]}