Pensieve header: Finding the most general R in abc notation.

SetDirectory@"C:\\drorbn\\AcademicPensieve\\Projects\\OneCo-1604";
<< abc.m

Finding R

VerifyR3[t_,expr_] := Module[{lhs,rhs},
lhs = expr // R[t,1,2] // R[t,1,3] // R[t,2,3] // S;
rhs = expr // R[t,2,3] // R[t,1,3] // R[t,1,2] // S;
expr -> S[lhs-rhs]==0
];
VerifyR3[expr_] := VerifyR3[1,expr];

ρ0[j_,k_]:=Total[MapIndexed[(#1 /. ff->(Subscript[ff, #2[[1]]]))& , DeleteCases[FormalBasis[{j,k},ff], _β|_a]]];
R[t_,j_,k_][x_] := Expand[
x // Ad[a[t,j,k]] // (#+t B[ρ0[j,k], #])&
];
R[j_,k_][x_] := R[1,j,k][x];

ρ0[j,k]

VerifyR3[a[f[(Subscript[b, 1]),(Subscript[b, 2]),(Subscript[b, 3]),(Subscript[b, 4])],1,4]]

(Subscript[ff, 22])[__]=0;  (Subscript[ff, 21])[__]=0;

VerifyR3[a[f[(Subscript[b, 1]),(Subscript[b, 2]),(Subscript[b, 3]),(Subscript[b, 4])],1,4]]

(Subscript[ff, 9])[__]=0; (Subscript[ff, 5])[__]=0;

VerifyR3[a[f[(Subscript[b, 1]),(Subscript[b, 2]),(Subscript[b, 3]),(Subscript[b, 4])],1,4]]

(Subscript[ff, 13])[__]=0; (Subscript[ff, 17])[__]=0;

VerifyR3[a[f[(Subscript[b, 1]),(Subscript[b, 2]),(Subscript[b, 3]),(Subscript[b, 4])],1,4]]

(Subscript[ff, 8])[x_,y_] := (Subscript[gg, 1])[x];

VerifyR3[a[f[(Subscript[b, 1]),(Subscript[b, 2]),(Subscript[b, 3]),(Subscript[b, 4])],1,4]]

VerifyR3[a[f[(Subscript[b, 1]),(Subscript[b, 2]),(Subscript[b, 3]),(Subscript[b, 4])],2,4]]

(Subscript[ff, 7])[__]=0;

VerifyR3[a[f[(Subscript[b, 1]),(Subscript[b, 2]),(Subscript[b, 3]),(Subscript[b, 4])],2,4]]

(Subscript[ff, 10])[x_,y_] := (Subscript[gg, 2])[y];

VerifyR3[a[f[(Subscript[b, 1]),(Subscript[b, 2]),(Subscript[b, 3]),(Subscript[b, 4])],2,4]]

(Subscript[ff, 1])[x_,y_] := (Subscript[gg, 3])[y];

VerifyR3[a[f[(Subscript[b, 1]),(Subscript[b, 2]),(Subscript[b, 3]),(Subscript[b, 4])],2,4]]

(Subscript[ff, 12])[(Subscript[b, j_]),(Subscript[b, k_])] := -(Subscript[b, j]) (Subscript[ff, 19])[(Subscript[b, j]),(Subscript[b, k])];

VerifyR3[a[f[(Subscript[b, 1]),(Subscript[b, 2]),(Subscript[b, 3]),(Subscript[b, 4])],2,4]]

(Subscript[gg, 1])[x_] := 0;

VerifyR3[a[f[(Subscript[b, 1]),(Subscript[b, 2]),(Subscript[b, 3]),(Subscript[b, 4])],2,4]]

(Subscript[ff, 19])[(Subscript[b, j_]),(Subscript[b, k_])] := -(((E^(-(Subscript[b, j]))) (2-2 (E^(Subscript[b, j]))+(Subscript[b, j])+(E^(Subscript[b, j])) (Subscript[b, j])))/(2 (Subscript[b, j]^3)));

VerifyR3[a[f[(Subscript[b, 1]),(Subscript[b, 2]),(Subscript[b, 3]),(Subscript[b, 4])],2,4]]

VerifyR3[a[f[(Subscript[b, 1]),(Subscript[b, 2]),(Subscript[b, 3]),(Subscript[b, 4])],3,4]]

(Subscript[ff, 16])[(Subscript[b, j_]),(Subscript[b, k_])] := (Subscript[gg, 4])[(Subscript[b, j])]; (Subscript[ff, 11])[(Subscript[b, j_]),(Subscript[b, k_])] := (Subscript[gg, 5])[(Subscript[b, j])];

VerifyR3[a[f[(Subscript[b, 1]),(Subscript[b, 2]),(Subscript[b, 3]),(Subscript[b, 4])],3,4]]

(Subscript[ff, 14])[(Subscript[b, j_]),(Subscript[b, k_])] := -(Subscript[b, j]) (Subscript[ff, 20])[(Subscript[b, j]),(Subscript[b, k])];

VerifyR3[a[f[(Subscript[b, 1]),(Subscript[b, 2]),(Subscript[b, 3]),(Subscript[b, 4])],3,4]]

Simplify[((E^(Subscript[b, 1])) (-1+(E^(Subscript[b, 2]))) (Subscript[b, 1]) (Subscript[ff, 20])[(Subscript[b, 1]),(Subscript[b, 3])]-(E^(Subscript[b, 2])) (-1+(E^(Subscript[b, 1]))) (Subscript[b, 2]) (Subscript[ff, 20])[(Subscript[b, 2]),(Subscript[b, 3])])==0]

((((E^(Subscript[b, 1]))  (Subscript[b, 1]) (Subscript[ff, 20])[(Subscript[b, 1]),(Subscript[b, 3])])/((-1+(E^(Subscript[b, 1])))))==(((E^(Subscript[b, 2]))  (Subscript[b, 2]) (Subscript[ff, 20])[(Subscript[b, 2]),(Subscript[b, 3])])/((-1+(E^(Subscript[b, 2])))))) /. (Subscript[ff, 20])[x_,y_] :> ((-1+(E^x))/((E^x)  x))(Subscript[gg, 6])[y]

(Subscript[ff, 20])[x_,y_] := ((-1+(E^x))/((E^x)  x))(Subscript[gg, 6])[y];

VerifyR3[a[f[(Subscript[b, 1]),(Subscript[b, 2]),(Subscript[b, 3]),(Subscript[b, 4])],3,4]]

Solve[(2 (-1+(E^(Subscript[b, 2])))-(1+(E^(Subscript[b, 2]))) (Subscript[b, 2])+2 (Subscript[b, 2]^2) ((Subscript[gg, 2])[(Subscript[b, 2])]+(E^(Subscript[b, 2])) (Subscript[gg, 5])[(Subscript[b, 2])]-(-1+(E^(Subscript[b, 2]))) (Subscript[gg, 6])[(Subscript[b, 2])]))==0, (Subscript[gg, 6])[(Subscript[b, 2])]] /. (Subscript[b, 2])->x

(Subscript[gg, 6])[x_] := ((-2+2 (E^x)-x-(E^x) x+2 (x^2) (Subscript[gg, 2])[x]+2 (E^x) (x^2) (Subscript[gg, 5])[x])/(2 (-1+(E^x)) (x^2)));

VerifyR3[a[f[(Subscript[b, 1]),(Subscript[b, 2]),(Subscript[b, 3]),(Subscript[b, 4])],3,4]]

Expand[ ((Subscript[ff, 2])[(Subscript[b, 1]),(Subscript[b, 2])]-(Subscript[ff, 2])[(Subscript[b, 1]),(Subscript[b, 3])]+(Subscript[b, 1]) ((Subscript[ff, 4])[(Subscript[b, 1]),(Subscript[b, 2])]-(Subscript[ff, 4])[(Subscript[b, 1]),(Subscript[b, 3])]))==0]

(Subscript[ff, 2])[(Subscript[b, 1]),(Subscript[b, 2])]+(Subscript[b, 1]) (Subscript[ff, 4])[(Subscript[b, 1]),(Subscript[b, 2])]==(Subscript[b, 1]) (Subscript[ff, 4])[(Subscript[b, 1]),(Subscript[b, 3])]+(Subscript[ff, 2])[(Subscript[b, 1]),(Subscript[b, 3])]

(Subscript[ff, 2])[(Subscript[b, 1]),(Subscript[b, 2])]+(Subscript[b, 1]) (Subscript[ff, 4])[(Subscript[b, 1]),(Subscript[b, 2])]==(Subscript[ff, 2])[(Subscript[b, 1]),(Subscript[b, 3])]+(Subscript[b, 1]) (Subscript[ff, 4])[(Subscript[b, 1]),(Subscript[b, 3])] /. (Subscript[ff, 2])[x_,y_] :> (Subscript[gg, 7])[x]-x (Subscript[ff, 4])[x,y]

(Subscript[ff, 2])[x_,y_] := (Subscript[gg, 7])[x]-x (Subscript[ff, 4])[x,y];

VerifyR3[a[f[(Subscript[b, 1]),(Subscript[b, 2]),(Subscript[b, 3]),(Subscript[b, 4])],3,4]]

t1=Collect[(2 (-1+(E^(Subscript[b, 1]))) (-1+(E^(Subscript[b, 2])))+2 (E^(Subscript[b, 2])) (-1+(E^(Subscript[b, 1]))) (Subscript[b, 2]^2) (Subscript[ff, 4])[(Subscript[b, 2]),(Subscript[b, 3])]+(Subscript[b, 2]) (2 (E^(Subscript[b, 1])) (-1+(E^(Subscript[b, 2]))) (Subscript[b, 1]) ((Subscript[ff, 4])[(Subscript[b, 1]),(Subscript[b, 2])]-(Subscript[ff, 4])[(Subscript[b, 1]),(Subscript[b, 3])])-(-1+(E^(Subscript[b, 1]))) (1+(E^(Subscript[b, 2]))+2 (Subscript[gg, 3])[(Subscript[b, 2])]+2 (E^(Subscript[b, 2])) (Subscript[gg, 7])[(Subscript[b, 2])]))), (Subscript[ff, _])[__], Simplify]

D[t1,(Subscript[b, 3])]/(2(Subscript[b, 2])) // Simplify

Simplify[(((E^(Subscript[b, 1]))(Subscript[b, 1]) Derivative[0,1][(Subscript[ff, 4])][(Subscript[b, 1]),(Subscript[b, 3])])/((-1+(E^(Subscript[b, 1])))))==(((E^(Subscript[b, 2]))  (Subscript[b, 2]) Derivative[0,1][(Subscript[ff, 4])][(Subscript[b, 2]),(Subscript[b, 3])])/((-1+(E^(Subscript[b, 2])))))]

Derivative[0,1][(Subscript[ff, 4])][(Subscript[b, 2]),(Subscript[b, 3])]==(((-1+(E^(Subscript[b, 2])))(Subscript[g, 8])[(Subscript[b, 3])])/((E^(Subscript[b, 2]))  (Subscript[b, 2])))

(Subscript[ff, 4])[x_,y_]:= (Subscript[gg, 9])[x]+(((E^(-x)) (-1+(E^x)) (Subscript[gg, 8])[y])/x);

VerifyR3[a[f[(Subscript[b, 1]),(Subscript[b, 2]),(Subscript[b, 3]),(Subscript[b, 4])],3,4]]

Solve[(2 (-1+(E^(Subscript[b, 2])))-(Subscript[b, 2]) (1+(E^(Subscript[b, 2]))+2 (Subscript[gg, 3])[(Subscript[b, 2])]+2 (E^(Subscript[b, 2])) (Subscript[gg, 7])[(Subscript[b, 2])]+2 (Subscript[gg, 8])[(Subscript[b, 2])]-2 (E^(Subscript[b, 2])) (Subscript[gg, 8])[(Subscript[b, 2])])+2 (E^(Subscript[b, 2])) (Subscript[b, 2]^2) (Subscript[gg, 9])[(Subscript[b, 2])])==0, #]& /@ {(Subscript[gg, 3])[(Subscript[b, 2])], (Subscript[gg, 7])[(Subscript[b, 2])], (Subscript[gg, 8])[(Subscript[b, 2])], (Subscript[gg, 9])[(Subscript[b, 2])]} /. (Subscript[b, 2])->x

(Subscript[gg, 9])[x_]:=(((E^(-x)) (2-2 (E^x)+x+(E^x) x+2 x (Subscript[gg, 3])[x]+2 (E^x) x (Subscript[gg, 7])[x]+2 x (Subscript[gg, 8])[x]-2 (E^x) x (Subscript[gg, 8])[x]))/(2 (x^2)));

VerifyR3[a[f[(Subscript[b, 1]),(Subscript[b, 2]),(Subscript[b, 3]),(Subscript[b, 4])],3,4]]

Verifying R

Print[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], a[f[(Subscript[b, 1]),(Subscript[b, 2]),(Subscript[b, 3]),(Subscript[b, 4])],4,1], a[f[(Subscript[b, 1]),(Subscript[b, 2]),(Subscript[b, 3]),(Subscript[b, 4])],4,2], a[f[(Subscript[b, 1]),(Subscript[b, 2]),(Subscript[b, 3]),(Subscript[b, 4])],4,3]};

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

Playing with R

S[ρ0[j,k]]

S[ρ0[j,k] /. {(Subscript[gg, 2|3|4|5])[_] -> 0, (Subscript[ff, 3|6|15|18|23])[__]->0, (Subscript[gg, 8])[x_]:>(((-1+(E^x)))^(-1)),(Subscript[gg, 7])[y_]:>-(((E^(-y)) (-1+(E^y)) (2-2 (E^(Subscript[b, k]))+y+(E^(Subscript[b, k])) y))/(2 (-1+(E^(Subscript[b, k]))) y))}]

S[ρ0[j,k] /. {(Subscript[gg, 2|3|4|5|7])[_] -> 0, (Subscript[ff, 3|6|15|18|23])[__]->0}]

(((E^(-(Subscript[b, j]))) (2 (-1+(E^(Subscript[b, j])))+(Subscript[b, j]) (-1-(E^(Subscript[b, j]))+2 (-1+(E^(Subscript[b, j]))) (Subscript[gg, 8])[(Subscript[b, j])]-2 (-1+(E^(Subscript[b, j]))) (Subscript[gg, 8])[(Subscript[b, k])])))/(2 (Subscript[b, j])))+(Subscript[b, j])(((E^(-(Subscript[b, j]))) (2-2 (E^(Subscript[b, j]))+(Subscript[b, j]) (1+(E^(Subscript[b, j]))-2 (-1+(E^(Subscript[b, j]))) (Subscript[gg, 8])[(Subscript[b, j])]+2 (-1+(E^(Subscript[b, j]))) (Subscript[gg, 8])[(Subscript[b, k])])))/(2 (Subscript[b, j]^2))) // Simplify

(((E^(-(Subscript[b, j]))) (2-2 (E^(Subscript[b, j]))+(1+(E^(Subscript[b, j]))) (Subscript[b, j])))/(2 (Subscript[b, j]^2)))+(Subscript[b, j])(-(((E^(-(Subscript[b, j]))) (2-2 (E^(Subscript[b, j]))+(1+(E^(Subscript[b, j]))) (Subscript[b, j])))/(2 (Subscript[b, j]^3)))) // Simplify

(((E^(-(Subscript[b, j]))) (-1+(E^(Subscript[b, j]))) (2-2 (E^(Subscript[b, k]))+(1+(E^(Subscript[b, k]))) (Subscript[b, k])))/(2 (-1+(E^(Subscript[b, k]))) (Subscript[b, k]^2)))+(Subscript[b, j])(-(((E^(-(Subscript[b, j]))) (-1+(E^(Subscript[b, j]))) (2-2 (E^(Subscript[b, k]))+(1+(E^(Subscript[b, k]))) (Subscript[b, k])))/(2 (-1+(E^(Subscript[b, k]))) (Subscript[b, j]) (Subscript[b, k]^2)))) // Simplify

S[ρ0[j,k] /. {(Subscript[gg, 2|3|4|5|7|8])[_] -> 0, (Subscript[ff, 3|6|15|18|23])[__]->0}]

R[1,2]@a[1,1,3] /. {(Subscript[gg, 2|3|4|5|7])[_] -> 0, (Subscript[ff, 3|6|15|18|23])[__]->0} // S

R[1,2]@a[1,2,3] /. {(Subscript[gg, 2|3|4|5|7])[_] -> 0, (Subscript[ff, 3|6|15|18|23])[__]->0} // S

R[1,2]@a[1,2,3] /. {(Subscript[gg, 2|3|4|5|7|8])[_] -> 0, (Subscript[ff, 3|6|15|18|23])[__]->0} // S

(a[1,3,4] // R[1,2] //R[1,3]//R[2,3])/. {(Subscript[gg, 2|3|4|5|7|8])[_] -> 0, (Subscript[ff, 3|6|15|18|23])[__]->0} // S

(a[1,3,4] // R[1,2] //R[1,3]//R[2,3]//R[3,1]//R[2,1])/. {(Subscript[gg, 2|3|4|5|7|8])[_] -> 0, (Subscript[ff, 3|6|15|18|23])[__]->0} // S

rule2={(Subscript[gg, 3|4|5|7|8])[_] -> 0, (Subscript[gg, 2])[x_] :> (E^x)/x, (Subscript[ff, _])[__]->0};
ρ0[j,k]/. rule2 // S

R[1,2]@a[1,1,∞] /. rule2 // S

R[1,2]@a[1,2,∞] /. rule2 // S