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

The Adjoint action

(Subscript[e, p_])[x_] := (x^(-p))((E^x)-(∑_(k=0)^(p-1))((x^k)/(k!)));
Unprotect[NonCommutativeMultiply];
0**_ := 0; _**0 := 0;
x_**(y_+z_) := x**y+x**z;
(x_+y_)**z_ := x**z+y**z;
L[g_] := L[1,g];
L /: L[f1_,g_] + L[f2_, g_] := L[f1+f2,g];
L /: c_*L[f_,g_] := L[c*f, g];
L /: L[f1_,1]**L[f2_,g_] := L[f1 f2, g];
L /: L[f1_,δ]**L[f2_,a[i_,j_]] := L[f1 f2, δa[i,j]];
L /: L[f1_,c[k_]]**L[f2_,a[i_,j_]] := L[f1 f2, ca[k,i,j]];
L /: L[f1_, δa[i_,j_]]**L[f2_,a[k_,l_]] := L[f1 f2, δa[i,j,k,l]];
L /: L[_, _c|_ca|_δa]**L[_,_c|_ca|_δa] := 0;
LSimp[L[f_,g_]] := L[FullSimplify[f], g] /. L[0,_] :> 0;
LSimp[expr_] := expr /. λ_L :> LSimp[λ];
expr_ // DegreeScale[t_] := expr /. L[f_,g_] :> LSimp[L[
(f /. (Subscript[b, i_]) :> t (Subscript[b, i]))*Switch[g,
1,1,
δ,t,
c[_], t,
a[_,_], t,
ca[_,_,_], (t^2),
δa[_,_,_,_], (t^3)
],g
]];
expr_ // Ad[t_*a[i_,j_]] := expr // DegreeScale[(t^(-1))] // Ad[a[i,j]] // DegreeScale[t];
DistinctQ[is___] := (Sort[{is}]===Union[{is}]);
expr_ // Ad[a[i_,j_]] := Expand[expr /. {
L[f_,c@i] :> L[f,c@i] + L[(((E^(-(Subscript[b, i])))-1)/(Subscript[b, i]))f, δa[i,j]] + L[(1-(E^(-(Subscript[b, i]))))f,c@j],
L[f_,c@j] :> L[(E^(-(Subscript[b, i])))f, c@j]+L[((1-(E^(-(Subscript[b, i]))))/(Subscript[b, i]))f, δa[i,j]],
L[f_,c@k_] /; k≠i&&k≠j :> L[f,c@k],
L[f_,δ] :> L[f,δ],
L[f_,1] :> L[f,1] + L[(1-(E^(-(Subscript[b, i]))))((∂_(Subscript[b, j]))f-(∂_(Subscript[b, i]))f),c@j] + L[(((E^(-(Subscript[b, i])))-1)/(Subscript[b, i]))((∂_(Subscript[b, j]))f-(∂_(Subscript[b, i]))f),δa[i,j]],
L[f_,δa[k_,j]] /; DistinctQ[i,j,k] :> L[(E^(-(Subscript[b, i])))f,δa[k,j]]+ L[((Subscript[b, k])/(Subscript[b, i]))(1-(E^(-(Subscript[b, i]))))f, δa[i,j]],
L[1,a[j,k_]] /; DistinctQ[i,j,k] :> L[(E^(Subscript[b, i])),a[j,k]] - L[(((Subscript[b, j])+(Subscript[b, i]) (1+(Subscript[b, j]))-(E^(Subscript[b, i])) ((Subscript[b, i])+(Subscript[b, j])))/(Subscript[b, i]^2)),ca[k,i,j]] + L[((Subscript[b, j])/(Subscript[b, i]))(1-(E^(Subscript[b, i]))), a[i,k]] + L[((Sinh[(Subscript[b, i])] (Subscript[b, i])+(-1+Cosh[(Subscript[b, i])]) (Subscript[b, j]))/(Subscript[b, i]^2)),ca[j,i,k]] + L[(((Subscript[b, i]) (-1+Cosh[(Subscript[b, i])]-(Subscript[b, j]))+Sinh[(Subscript[b, i])] (Subscript[b, j]))/(Subscript[b, i]^3)),δa[i,j,i,k]],
L[f_,δa[j,k_]] /; DistinctQ[i,j,k] :> L[(E^(Subscript[b, i]))f, δa[j,k]]+L[((Subscript[b, j])/(Subscript[b, i]))(1-(E^(Subscript[b, i])))f, δa[i,k]],
L[f_,δa[k_,i]] /; DistinctQ[i,j,k]:> L[f,δa[k,i]] + L[(1-(E^(-(Subscript[b, i]))))f,δa[k,j]] + L[((Subscript[b, k])/(Subscript[b, i]))((E^(-(Subscript[b, i])))-1)f, δa[i,j]],
L[f_,δa[j,i]] :> L[(E^(Subscript[b, i]))f,δa[j,i]] + L[((Subscript[b, j])/(Subscript[b, i]))(1-(E^(Subscript[b, i])))f,δa[i,j]],
L[1,a[i,k_]] :> L[1,a[i,k]] + L[1,ca[k,i,j]] + L[(((E^(-(Subscript[b, i])))-1)/(Subscript[b, i])),ca[j,i,k]] + L[((1-(Subscript[b, i])-(E^(-(Subscript[b, i]))))/((Subscript[b, i])^2)),δa[i,j,i,k]],
L[f_,δa[i,k_]] :> L[f,δa[i,k]],
L[f_,a[k_,l_]] /; DistinctQ[i,j,k,l] :> L[f, a[k,l]],
L[f_,δa[k_,l_]] /; DistinctQ[i,j,k,l] :> L[f, δa[k,l]],
L[f_,ca[k_,l_,m_]] :> (L[f,c[k]]//Ad[a[i,j]])**((L[1,δa[l,m]]//Ad[a[i,j]]) /. δa->a),
L[f_,δa[k_,l_,m_,n_]] :> (L[f,δa[k,l]]//Ad[a[i,j]])**((L[1,δa[m,n]]//Ad[a[i,j]]) /. δa->a),
L[f_,g_] /; (f=!=1) && (g=!=1) :> (L[f,1]//Ad[a[i,j]])**(L[1,g]//Ad[a[i,j]]),
L[f_,g_] -> TBD[a[i,j],f,g]
}]

-((Subscript[e, 1])[(Subscript[b, i])]+(Subscript[b, j])(Subscript[e, 2])[(Subscript[b, i])]) // FullSimplify

(((Subscript[e, 0])[(Subscript[b, i])]-(Subscript[e, 0])[-(Subscript[b, i])]+(Subscript[b, j])((Subscript[e, 1])[(Subscript[b, i])]-(Subscript[e, 1])[-(Subscript[b, i])]))/(2(Subscript[b, i]))) // FullSimplify

(((Subscript[e, 1])[(Subscript[b, i])]-(Subscript[e, 1])[-(Subscript[b, i])]+(Subscript[b, j])((Subscript[e, 2])[(Subscript[b, i])]-(Subscript[e, 2])[-(Subscript[b, i])]))/(2(Subscript[b, i]))) // FullSimplify

Series[(((Subscript[b, i]) (-1+Cosh[(Subscript[b, i])]-(Subscript[b, j]))+Sinh[(Subscript[b, i])] (Subscript[b, j]))/(Subscript[b, i]^3)), {(Subscript[b, i]),0,3}]

The semi-group property

L[1,a[1,4]] // Ad[x a[1,2]] // Ad[y a[1,2]]

L[1,a[1,4]] // Ad[(x+y) a[1,2]]

L[1,a[2,4]] // Ad[x a[1,2]]

t1=L[1,a[2,4]] // Ad[x a[1,2]] // Ad[y a[1,2]]

t2=L[1,a[2,4]] // Ad[(x+y) a[1,2]]

t1-t2

R

R[i_,j_] := Ad[a[i,j]]

Verifying R3

Verify[expr_] := Module[{lhs,rhs}, {
lhs = expr // R[1,2] // R[1,3] // R[2,3] // LSimp,
rhs = expr // R[2,3] // R[1,3] // R[1,2] // LSimp,
LSimp[lhs-rhs]==0
}]

L[1,a[1,4]] // Verify // ColumnForm

L[1,a[2,4]] // Verify // ColumnForm

L[c@1] // Verify // ColumnForm

L[c@2] // Verify // ColumnForm

L[c@3] // Verify // ColumnForm

L[f[(Subscript[b, 1]),(Subscript[b, 2]),(Subscript[b, 3])],1] // Verify // ColumnForm