Pensieve header: Finding the most general R using low algebra.

Warning: b->B !

SetDirectory["C:\\drorbn\\AcademicPensieve\\Projects\\OneCo-1606"];
<< OneCo.m

Finding R

bas=Cases[LBasis[{j,k}],ϵ*U[__]]

Sum[(Subscript[f, i])[(Subscript[β, j]),(Subscript[β, k])]bas[[i]], {i,Length@bas}]

ρ0[j_,k_] :=ϵ U[(Subscript[c, j])] (Subscript[f, 1])[(Subscript[β, j]),(Subscript[β, k])]+ϵ U[(Subscript[c, k])] (Subscript[f, 2])[(Subscript[β, j]),(Subscript[β, k])]+ϵ U[(Subscript[u, j])] (Subscript[f, 3])[(Subscript[β, j]),(Subscript[β, k])]+ϵ U[(Subscript[u, k])] (Subscript[f, 4])[(Subscript[β, j]),(Subscript[β, k])]+ϵ U[(Subscript[w, j])] (Subscript[f, 5])[(Subscript[β, j]),(Subscript[β, k])]+ϵ U[(Subscript[w, k])] (Subscript[f, 6])[(Subscript[β, j]),(Subscript[β, k])]+ϵ U[(Subscript[c, j]),(Subscript[c, j])] (Subscript[f, 7])[(Subscript[β, j]),(Subscript[β, k])]+ϵ U[(Subscript[c, j]),(Subscript[c, k])] (Subscript[f, 8])[(Subscript[β, j]),(Subscript[β, k])]+ϵ U[(Subscript[c, j]),(Subscript[u, j])] (Subscript[f, 9])[(Subscript[β, j]),(Subscript[β, k])]+ϵ U[(Subscript[c, j]),(Subscript[u, k])] (Subscript[f, 10])[(Subscript[β, j]),(Subscript[β, k])]+ϵ U[(Subscript[c, j]),(Subscript[w, j])] (Subscript[f, 11])[(Subscript[β, j]),(Subscript[β, k])]+ϵ U[(Subscript[c, j]),(Subscript[w, k])] (Subscript[f, 12])[(Subscript[β, j]),(Subscript[β, k])]+ϵ U[(Subscript[c, k]),(Subscript[c, k])] (Subscript[f, 13])[(Subscript[β, j]),(Subscript[β, k])]+ϵ U[(Subscript[c, k]),(Subscript[u, j])] (Subscript[f, 14])[(Subscript[β, j]),(Subscript[β, k])]+ϵ U[(Subscript[c, k]),(Subscript[u, k])] (Subscript[f, 15])[(Subscript[β, j]),(Subscript[β, k])]+ϵ U[(Subscript[c, k]),(Subscript[w, j])] (Subscript[f, 16])[(Subscript[β, j]),(Subscript[β, k])]+ϵ U[(Subscript[c, k]),(Subscript[w, k])] (Subscript[f, 17])[(Subscript[β, j]),(Subscript[β, k])]+ϵ U[(Subscript[u, j]),(Subscript[w, j])] (Subscript[f, 18])[(Subscript[β, j]),(Subscript[β, k])]+ϵ U[(Subscript[u, j]),(Subscript[w, k])] (Subscript[f, 19])[(Subscript[β, j]),(Subscript[β, k])]+ϵ U[(Subscript[u, k]),(Subscript[w, j])] (Subscript[f, 20])[(Subscript[β, j]),(Subscript[β, k])]+ϵ U[(Subscript[u, k]),(Subscript[w, k])] (Subscript[f, 21])[(Subscript[β, j]),(Subscript[β, k])]+ϵ U[(Subscript[c, j]),(Subscript[u, j]),(Subscript[w, j])] (Subscript[f, 22])[(Subscript[β, j]),(Subscript[β, k])]+ϵ U[(Subscript[c, j]),(Subscript[u, j]),(Subscript[w, k])] (Subscript[f, 23])[(Subscript[β, j]),(Subscript[β, k])]+ϵ U[(Subscript[c, j]),(Subscript[u, k]),(Subscript[w, j])] (Subscript[f, 24])[(Subscript[β, j]),(Subscript[β, k])]+ϵ U[(Subscript[c, j]),(Subscript[u, k]),(Subscript[w, k])] (Subscript[f, 25])[(Subscript[β, j]),(Subscript[β, k])]+ϵ U[(Subscript[c, k]),(Subscript[u, j]),(Subscript[w, j])] (Subscript[f, 26])[(Subscript[β, j]),(Subscript[β, k])]+ϵ U[(Subscript[c, k]),(Subscript[u, j]),(Subscript[w, k])] (Subscript[f, 27])[(Subscript[β, j]),(Subscript[β, k])]+ϵ U[(Subscript[c, k]),(Subscript[u, k]),(Subscript[w, j])] (Subscript[f, 28])[(Subscript[β, j]),(Subscript[β, k])]+ϵ U[(Subscript[c, k]),(Subscript[u, k]),(Subscript[w, k])] (Subscript[f, 29])[(Subscript[β, j]),(Subscript[β, k])]+ϵ U[(Subscript[u, j]),(Subscript[u, j]),(Subscript[w, j])] (Subscript[f, 30])[(Subscript[β, j]),(Subscript[β, k])]+ϵ U[(Subscript[u, j]),(Subscript[u, j]),(Subscript[w, k])] (Subscript[f, 31])[(Subscript[β, j]),(Subscript[β, k])]+ϵ U[(Subscript[u, j]),(Subscript[u, k]),(Subscript[w, j])] (Subscript[f, 32])[(Subscript[β, j]),(Subscript[β, k])]+ϵ U[(Subscript[u, j]),(Subscript[u, k]),(Subscript[w, k])] (Subscript[f, 33])[(Subscript[β, j]),(Subscript[β, k])]+ϵ U[(Subscript[u, j]),(Subscript[w, j]),(Subscript[w, j])] (Subscript[f, 34])[(Subscript[β, j]),(Subscript[β, k])]+ϵ U[(Subscript[u, j]),(Subscript[w, j]),(Subscript[w, k])] (Subscript[f, 35])[(Subscript[β, j]),(Subscript[β, k])]+ϵ U[(Subscript[u, j]),(Subscript[w, k]),(Subscript[w, k])] (Subscript[f, 36])[(Subscript[β, j]),(Subscript[β, k])]+ϵ U[(Subscript[u, k]),(Subscript[u, k]),(Subscript[w, j])] (Subscript[f, 37])[(Subscript[β, j]),(Subscript[β, k])]+ϵ U[(Subscript[u, k]),(Subscript[u, k]),(Subscript[w, k])] (Subscript[f, 38])[(Subscript[β, j]),(Subscript[β, k])]+ϵ U[(Subscript[u, k]),(Subscript[w, j]),(Subscript[w, j])] (Subscript[f, 39])[(Subscript[β, j]),(Subscript[β, k])]+ϵ U[(Subscript[u, k]),(Subscript[w, j]),(Subscript[w, k])] (Subscript[f, 40])[(Subscript[β, j]),(Subscript[β, k])]+ϵ U[(Subscript[u, k]),(Subscript[w, k]),(Subscript[w, k])] (Subscript[f, 41])[(Subscript[β, j]),(Subscript[β, k])]+ϵ U[(Subscript[u, j]),(Subscript[u, j]),(Subscript[w, j]),(Subscript[w, j])] (Subscript[f, 42])[(Subscript[β, j]),(Subscript[β, k])]+ϵ U[(Subscript[u, j]),(Subscript[u, j]),(Subscript[w, j]),(Subscript[w, k])] (Subscript[f, 43])[(Subscript[β, j]),(Subscript[β, k])]+ϵ U[(Subscript[u, j]),(Subscript[u, j]),(Subscript[w, k]),(Subscript[w, k])] (Subscript[f, 44])[(Subscript[β, j]),(Subscript[β, k])]+ϵ U[(Subscript[u, j]),(Subscript[u, k]),(Subscript[w, j]),(Subscript[w, j])] (Subscript[f, 45])[(Subscript[β, j]),(Subscript[β, k])]+ϵ U[(Subscript[u, j]),(Subscript[u, k]),(Subscript[w, j]),(Subscript[w, k])] (Subscript[f, 46])[(Subscript[β, j]),(Subscript[β, k])]+ϵ U[(Subscript[u, j]),(Subscript[u, k]),(Subscript[w, k]),(Subscript[w, k])] (Subscript[f, 47])[(Subscript[β, j]),(Subscript[β, k])]+ϵ U[(Subscript[u, k]),(Subscript[u, k]),(Subscript[w, j]),(Subscript[w, j])] (Subscript[f, 48])[(Subscript[β, j]),(Subscript[β, k])]+ϵ U[(Subscript[u, k]),(Subscript[u, k]),(Subscript[w, j]),(Subscript[w, k])] (Subscript[f, 49])[(Subscript[β, j]),(Subscript[β, k])]+ϵ U[(Subscript[u, k]),(Subscript[u, k]),(Subscript[w, k]),(Subscript[w, k])] (Subscript[f, 50])[(Subscript[β, j]),(Subscript[β, k])]

R[j_,k_][ℰ_] :=  Simp[ℰ // Ea[j,k] // (#+b[ρ0[j,k],#])&]

U[(Subscript[c, 1])]//R[1,2] // Simp // Short

U[(Subscript[c, 1])]//R[1,2] // R[1,3] // R[2,3]

R3[ℰ_] := Simp[(ℰ//R[1,2] // R[1,3] // R[2,3])-(ℰ//R[2,3] // R[1,3] // R[1,2])]

R3s=Flatten[Table[U@(Subscript[y, i])->R3[U@(Subscript[y, i])], {y,{c,u,w}}, {i,3}]]

R3s /. ϵ->0

bas3=Cases[LBasis[{1,2,3}],ϵ*U[__]]

Errors=Union[DeleteCases[
Flatten[Table[Simplify@Coefficient[U@(Subscript[y, i]) /. R3s, e], {y,{u,w}}, {i,3}, {e,bas3}]] /. {(Subscript[β, 1])->x,(Subscript[β, 2])->y,(Subscript[β, 3])->z},
0]] // SortBy[LeafCount]

DeleteFile["Errors.m"];
Errors >> "Errors.m"

E0=Factor/@Errors;
s1=Cases[E0, _.*(Subscript[f, k_])[__]:>k] // Union

EC=((Subscript[f, #])[_,_]->0)& /@ s1

E0=Factor/@(Errors /. EC);
s1=Cases[E0, _.*(Subscript[f, k_])[__]:>k] // Union

EC=EC⋃(((Subscript[f, #])[_,_]->0)& /@ s1)

E0=Factor/@(Errors /. EC);
s1=Cases[E0, _.*(Subscript[f, k_])[__]:>k] // Union

EC=EC⋃(((Subscript[f, #])[_,_]->0)& /@ s1)

E0=Factor/@(Errors /. EC);
s1=Cases[E0, _.*(Subscript[f, k_])[__]:>k] // Union

DeleteCases[E0,0]//Union//SortBy[LeafCount]

R3 on (Subscript[u, 1])

R3u1=R3[U@(Subscript[u, 1])];

The following were obtained by watching Dynamic[R3u1 // Simp] and repeatedly simplifying it:

Factor@Coefficient[R3u1, ϵ U[(Subscript[c, 1]),(Subscript[u, 2])]]

(Subscript[f, 25])[x_,y_]:=0;

Factor@Coefficient[R3u1, ϵ (Subscript[c, 3])(Subscript[u, 2])]

(Subscript[f, 26])[x_,y_]:=0;

Factor@Coefficient[R3u1, ϵ (Subscript[u, 2])(Subscript[u, 3])(Subscript[w, 1])]

(Subscript[f, 44])[x_,y_]:=0;

Factor@Coefficient[R3u1, ϵ (Subscript[u, 1])(Subscript[u, 3])(Subscript[w, 2])]

(Subscript[f, 43])[x_,y_]:=0;

Factor@Coefficient[R3u1, ϵ (Subscript[u, 3])(Subscript[w, 2])]

(Subscript[f, 30])[x_,y_]:=0;

Factor@Coefficient[R3u1, ϵ (Subscript[u, 1])(Subscript[u, 3])]

(Subscript[f, 12])[x_,y_]:=x (Subscript[f, 27])[x,y];

Factor@Coefficient[R3u1, ϵ (Subscript[u, 2])(Subscript[u, 3])(Subscript[w, 3])]

(Subscript[f, 47])[x_,y_]:=0;

Factor@Coefficient[R3u1, ϵ ((Subscript[u, 2])^2)]

(Subscript[f, 28])[x_,y_]:=0;

Factor@Coefficient[R3u1, ϵ (Subscript[u, 3])]

(Subscript[f, 17])[x_,y_]:=0;

Factor@Coefficient[R3u1, ϵ ((Subscript[u, 1])^2)(Subscript[w, 2])]

(Subscript[f, 7])[x_,y_]:=x (Subscript[f, 22])[x,y]-(x^2)(Subscript[f, 42])[x,y]

Factor@Coefficient[R3u1, ϵ (Subscript[u, 1])(Subscript[w, 2])]

(Subscript[f, 14])[x_,y_]:=x (Subscript[f, 29])[x,y];

Factor@Coefficient[R3u1, ϵ ((Subscript[u, 1])^2)(Subscript[w, 3])]

(Subscript[f, 31])[x_,y_] := (Subscript[g, 1])[x]+x (Subscript[f, 45])[x,y]

Factor[Coefficient[R3u1, ϵ (Subscript[u, 2])(Subscript[w, 3])]/.(Subscript[u, 1])->0]

(Subscript[f, 15])[x_,y_] := (Subscript[g, 2])[x]+y (Subscript[f, 39])[x,y]

Factor[Coefficient[R3u1, ϵ (Subscript[u, 1])(Subscript[w, 3])] /. (Subscript[u, 2])->0]

(Subscript[f, 18])[x_,y_] := (Subscript[g, 3])[x]+x (Subscript[f, 38])[x,y]

Factor[Coefficient[R3u1, ϵ (Subscript[u, 1])(Subscript[u, 2])(Subscript[w, 3])]]

(Subscript[f, 8])[x_,y_] := (Subscript[g, 4])[x]+x (Subscript[f, 23])[x,y]+y (Subscript[f, 34])[x,y]-x y (Subscript[f, 46])[x,y]

R3 on (Subscript[w, 1])

R3w1=R3[(Subscript[w, 1])] /. {(Subscript[b, 1])->x, (Subscript[b, 2])->y, (Subscript[b, 3])->z};

The following were obtained by watching Dynamic[R3w1 // Simp] and repeatedly simplifying it:

tt1=Factor[Coefficient[R3w1, ϵ (Subscript[u, 1])(Subscript[w, 2])(Subscript[w, 3])]]

Solve[tt1==0,  (Subscript[f, 48])[(Subscript[b, 1]),(Subscript[b, 2])]] /. {(Subscript[b, 1])->x, (Subscript[b, 2])->y, (Subscript[b, 3])->z}

(Subscript[f, 48])[x_,y_]:=(1/(4 (x^3)))(2-2 (E^(2 x))+x+2 (E^x) x+(E^(2 x)) x+2 (x^2) (Subscript[f, 32])[x,y]-2 (E^x) (x^2) (Subscript[f, 32])[x,y]-2 (x^2) y (Subscript[f, 49])[x,y]+2 (E^x) (x^2) y (Subscript[f, 49])[x,y]-2 (x^2) (Subscript[g, 1])[x]+2 (E^x) (x^2) (Subscript[g, 1])[x]+x (Subscript[g, 4])[x]-2 (E^x) x (Subscript[g, 4])[x]+(E^(2 x)) x (Subscript[g, 4])[x])

tt1=Simplify[Coefficient[R3w1, ϵ (Subscript[u, 2])(Subscript[w, 2])]/.(Subscript[w, 3])->0]

(Subscript[f, 10])[x_,y_] := 2x (Subscript[f, 24])[x,y]+y (Subscript[f, 27])[x,y]

tt1=Simplify[Coefficient[R3w1, ϵ (Subscript[u, 2])((Subscript[w, 2])^2)]/.(Subscript[w, 3])->0]

(Subscript[f, 22])[x_,y_] := 2x (Subscript[f, 42])[x,y]

tt1=Simplify[Coefficient[R3w1, ϵ (Subscript[c, 3])]/.{(Subscript[w, 3])->0, (Subscript[w, 2])->0}]

(Subscript[f, 11])[y_,z_]:=((-z)/y) (Subscript[f, 13])[y,z]

tt1=Simplify[Coefficient[R3w1, ϵ (Subscript[c, 3])]/.{(Subscript[w, 3])->0, (Subscript[w, 2])->0}]

tt1=Simplify[Coefficient[R3w1, ϵ ]/.{(Subscript[u, _])->0, (Subscript[w, _])->0, (Subscript[c, _])->0}]

Solve[tt1==0, (Subscript[f, 3])[y,z]]

(Subscript[f, 3])[y_,z_]:=((-z (Subscript[f, 4])[y,z]-z (Subscript[f, 13])[y,z]-2 (y^2) (Subscript[f, 24])[y,z]-y z (Subscript[f, 27])[y,z])/y)

tt1=Simplify[Coefficient[R3w1, ϵ (Subscript[u, 3])(Subscript[w, 3])]/.{(Subscript[u, _])->0, (Subscript[w, _])->0, (Subscript[c, _])->0}]

Solve[tt1==0, (Subscript[f, 13])[y,z]]

(Subscript[f, 13])[y_,z_]:=y (Subscript[f, 36])[y,z]+2 z (Subscript[f, 37])[y,z]

tt1=Simplify[Coefficient[R3w1, ϵ (Subscript[c, 2])]/.{(Subscript[u, _])->0, (Subscript[w, _])->0, (Subscript[c, _])->0}]

Solve[tt1==0, (Subscript[f, 24])[y,z]]

(Subscript[f, 24])[y_,z_]:=-((z (Subscript[f, 27])[y,z])/y)

tt1=Simplify[Coefficient[R3w1, ϵ (Subscript[c, 2])]/.{(Subscript[u, _])->0, (Subscript[w, _])->0, (Subscript[c, _])->0}]

Not finished!

R3 on (Subscript[w, 3])

R3w3=R3[(Subscript[w, 3])] /.  {(Subscript[b, 1])->x, (Subscript[b, 2])->y, (Subscript[b, 3])->z};

The following were obtained by watching Dynamic[R3w3 // Simp] and repeatedly simplifying it:

tt1=Simplify[Coefficient[R3w3, ϵ (Subscript[c, 1])]/.{(Subscript[u, _])->0, (Subscript[w, _])->0, (Subscript[c, _])->0}]

(Subscript[f, 27])[x_,z_] := 0

tt1=Simplify[Coefficient[R3w3, ϵ (Subscript[w, 2])(Subscript[w, 3])]/.{(Subscript[u, _])->0, (Subscript[w, _])->0, (Subscript[c, _])->0}]

(Subscript[g, 2])[x_]:= 0

tt1=Simplify[Coefficient[R3w3, ϵ (Subscript[u, 2])((Subscript[w, 3])^2)]/.{(Subscript[u, _])->0, (Subscript[w, _])->0, (Subscript[c, _])->0}]

Solve[tt1==0, (Subscript[f, 9])[x,z]]

(Subscript[f, 9])[x_,z_]:=-z (-(Subscript[f, 35])[x,z]+z (Subscript[f, 50])[x,z])

tt1=Simplify[Coefficient[R3w3, ϵ (Subscript[u, 1])(Subscript[w, 2])(Subscript[w, 3])]/.{(Subscript[u, _])->0, (Subscript[w, _])->0, (Subscript[c, _])->0}]

(Subscript[g, 4])[x_]:= 0

Not finished!

R3 on (Subscript[u, 2])

R3u2=R3[(Subscript[u, 2])];

The following were obtained by watching Dynamic[R3u2 // Simp] and repeatedly simplifying it:

Factor[Coefficient[R3u2, ϵ (Subscript[u, 3])(Subscript[w, 3])]/.(Subscript[u, 1])->0]

(Subscript[f, 39])[x_,y_] := (Subscript[g, 5])[y]

Factor[Coefficient[R3u2, ϵ (Subscript[c, 1])]]

(Subscript[f, 29])[x_,y_] := 0

Factor[Coefficient[R3u2,ϵ (Subscript[u, 1])(Subscript[u, 3])(Subscript[w, 3])]]

(Subscript[f, 34])[x_,y_] := (Subscript[g, 6])[y] + x (Subscript[f, 46])[x,y]

Factor[Coefficient[R3u2,ϵ (Subscript[u, 1])(Subscript[w, 3])] /. (Subscript[u, 2])->0]

Solve[-(1/(Subscript[b, 1]))(E^(-(Subscript[b, 1]))) (Subscript[b, 2]) (2 (Subscript[b, 1]) (Subscript[f, 40])[(Subscript[b, 1]),(Subscript[b, 2])]-2 (E^(Subscript[b, 2])) (Subscript[b, 1]) (Subscript[f, 40])[(Subscript[b, 1]),(Subscript[b, 2])]+(Subscript[g, 3])[(Subscript[b, 1])]-(E^(Subscript[b, 1])) (Subscript[g, 3])[(Subscript[b, 1])]-(E^(Subscript[b, 2])) (Subscript[g, 3])[(Subscript[b, 1])]+(E^((Subscript[b, 1])+(Subscript[b, 2]))) (Subscript[g, 3])[(Subscript[b, 1])]-(E^(Subscript[b, 1])) (Subscript[g, 3])[(Subscript[b, 2])]+(E^(2 (Subscript[b, 1]))) (Subscript[g, 3])[(Subscript[b, 2])])==0, (Subscript[f, 40])[(Subscript[b, 1]),(Subscript[b, 2])]] /. {(Subscript[b, 1])->x, (Subscript[b, 2])->y}

(Subscript[f, 40])[x_,y_]:=(((-1+(E^x)) (-(Subscript[g, 3])[x]+(E^y) (Subscript[g, 3])[x]+(E^x) (Subscript[g, 3])[y]))/(2 (-1+(E^y)) x))

Factor[Coefficient[R3u2,ϵ ((Subscript[u, 1])^2)(Subscript[w, 3])]]

Solve[(1/(2 (Subscript[b, 1]^3)))(E^(-(Subscript[b, 1]))) (-1+(E^(Subscript[b, 1]))) (Subscript[b, 2]) (-2+2 (E^(Subscript[b, 1]))+2 (E^(Subscript[b, 2]))-2 (E^((Subscript[b, 1])+(Subscript[b, 2])))-(Subscript[b, 1])-(E^(Subscript[b, 1])) (Subscript[b, 1])+(E^(Subscript[b, 2])) (Subscript[b, 1])+(E^((Subscript[b, 1])+(Subscript[b, 2]))) (Subscript[b, 1])+2 (Subscript[b, 1]^2) (Subscript[f, 32])[(Subscript[b, 1]),(Subscript[b, 2])]-2 (E^(Subscript[b, 2])) (Subscript[b, 1]^2) (Subscript[f, 32])[(Subscript[b, 1]),(Subscript[b, 2])]-2 (Subscript[b, 1]^2) (Subscript[b, 2]) (Subscript[f, 49])[(Subscript[b, 1]),(Subscript[b, 2])]+2 (E^(Subscript[b, 2])) (Subscript[b, 1]^2) (Subscript[b, 2]) (Subscript[f, 49])[(Subscript[b, 1]),(Subscript[b, 2])]+2 (Subscript[b, 1]) (Subscript[b, 2]) (Subscript[g, 1])[(Subscript[b, 2])]-2 (E^(Subscript[b, 1])) (Subscript[b, 1]) (Subscript[b, 2]) (Subscript[g, 1])[(Subscript[b, 2])])==0, (Subscript[f, 49])[(Subscript[b, 1]),(Subscript[b, 2])]] /. {(Subscript[b, 1])->x, (Subscript[b, 2])->y}

(Subscript[f, 49])[x_,y_]:=((2-2 (E^x)-2 (E^y)+2 (E^(x+y))+x+(E^x) x-(E^y) x-(E^(x+y)) x-2 (x^2) (Subscript[f, 32])[x,y]+2 (E^y) (x^2) (Subscript[f, 32])[x,y]-2 x y (Subscript[g, 1])[y]+2 (E^x) x y (Subscript[g, 1])[y])/(2 (-1+(E^y)) (x^2) y))

Factor[Coefficient[R3u2,ϵ (Subscript[u, 2])(Subscript[w, 3])] /. (Subscript[u, 1])->0]

Solve[-(E^(-(Subscript[b, 1]))) (-2 (Subscript[f, 19])[(Subscript[b, 1]),(Subscript[b, 2])]+2 (E^(Subscript[b, 2])) (Subscript[f, 19])[(Subscript[b, 1]),(Subscript[b, 2])]+2 (Subscript[b, 2]) (Subscript[f, 41])[(Subscript[b, 1]),(Subscript[b, 2])]-2 (E^(Subscript[b, 2])) (Subscript[b, 2]) (Subscript[f, 41])[(Subscript[b, 1]),(Subscript[b, 2])]-(Subscript[g, 3])[(Subscript[b, 2])]+(E^(Subscript[b, 1])) (Subscript[g, 3])[(Subscript[b, 2])])==0, (Subscript[f, 19])[(Subscript[b, 1]),(Subscript[b, 2])]] /. {(Subscript[b, 1])->x, (Subscript[b, 2])->y}

(Subscript[f, 19])[x_,y_]:=((-2 y (Subscript[f, 41])[x,y]+2 (E^y) y (Subscript[f, 41])[x,y]+(Subscript[g, 3])[y]-(E^x) (Subscript[g, 3])[y])/(2 (-1+(E^y))))

Factor[Coefficient[R3u2,ϵ (Subscript[u, 1])]]

tt1=Factor[(((Subscript[b, 1]) Coefficient[R3u2,ϵ (Subscript[u, 1])])/((E^(-(Subscript[b, 1]))) (-1+(E^(Subscript[b, 1]))) (Subscript[b, 2]) ))] /.  {(Subscript[b, 1])->x, (Subscript[b, 2])->y, (Subscript[b, 3])->z} /. (Subscript[f, _])[y,z] -> 0

(Subscript[f, 1])[x_,z_]:=(Subscript[g, 7])[z]-(-x (Subscript[f, 16])[x,z]-(x^2) (Subscript[f, 42])[x,z])

Factor[Coefficient[R3u2,ϵ]]

(Subscript[f, 5])[x_,y_] := (Subscript[g, 8])[y]

R3 on (Subscript[w, 2])

R3w2=R3[(Subscript[w, 2])] /.  {(Subscript[b, 1])->x, (Subscript[b, 2])->y, (Subscript[b, 3])->z};

The following were obtained by watching Dynamic[R3w2 // Simp] and repeatedly simplifying it:

tt1=Simplify[Coefficient[R3w2, ϵ (Subscript[u, 3])((Subscript[w, 3])^2)]/.{(Subscript[u, _])->0, (Subscript[w, _])->0, (Subscript[c, _])->0}]

(Subscript[f, 35])[x_,z_]:=2 z (Subscript[f, 50])[x,z]

tt1=Simplify[Coefficient[R3w2, ϵ (Subscript[c, 1])(Subscript[w, 3])]/.{(Subscript[u, _])->0, (Subscript[w, _])->0, (Subscript[c, _])->0}]

(Subscript[f, 23])[x_,y_]:= (Subscript[g, 9])[x]+y (Subscript[f, 46])[x,y]

tt1=Simplify[Coefficient[R3w2, ϵ (Subscript[w, 3])]/.{(Subscript[u, _])->0, (Subscript[w, _])->0, (Subscript[c, _])->0}]

(Subscript[f, 2])[x_,y_] := (Subscript[g, 10])[x]+y (Subscript[f, 21])[x,y]+(y^2) (Subscript[f, 50])[x,y]

tt1=Simplify[Coefficient[R3w2, ϵ (Subscript[c, 3])]/.{(Subscript[u, _])->0, (Subscript[w, _])->0, (Subscript[c, _])->0}]

(E^x) (((-1+(E^x)))^(-1)) x (Subscript[f, 36])[x,z]+2 z (E^x) (((-1+(E^x)))^(-1)) (Subscript[f, 37])[x,z]==(E^y) (((-1+(E^y)) )^(-1))y (Subscript[f, 36])[y,z]+2 z (E^y) (((-1+(E^y)))^(-1)) (Subscript[f, 37])[y,z]

Solve[(E^x) (((-1+(E^x)))^(-1)) x (Subscript[f, 36])[x,z]+2 z (E^x) (((-1+(E^x)))^(-1)) (Subscript[f, 37])[x,z]==(Subscript[g, 11])[z],(Subscript[f, 36])[x,z]]

(Subscript[f, 36])[x_,z_]:=-(((E^(-x)) (2 (E^x) z (Subscript[f, 37])[x,z]+(Subscript[g, 11])[z]-(E^x) (Subscript[g, 11])[z]))/x)

Assorted

tt1=Simplify[Coefficient[R3w3, ϵ ]/.{(Subscript[u, _])->0, (Subscript[w, _])->0, (Subscript[c, _])->0}]

Solve[(E^x) (((-1+(E^x)))^(-1)) (Subscript[f, 4])[x,z]==(Subscript[g, 12])[z], (Subscript[f, 4])[x,z]]

(Subscript[f, 4])[x_,z_]:=(E^(-x)) (-1+(E^x)) (Subscript[g, 12])[z]

tt1=Simplify[Coefficient[R3w3, ϵ (Subscript[u, 3])(Subscript[w, 3])]/.{(Subscript[u, _])->0, (Subscript[w, _])->0, (Subscript[c, _])->0}]

(Subscript[f, 37])[x_,z_]:=(E^(-x)) (-1+(E^x)) (Subscript[g, 13])[z]

tt1=Simplify[Coefficient[R3w2, ϵ (Subscript[u, 2])(Subscript[w, 3])]/.{(Subscript[u, _])->0, (Subscript[w, _])->0, (Subscript[c, _])->0}]

Solve[tt1==0,  (Subscript[f, 33])[y,z]]

(Subscript[f, 33])[y_,z_]:=(((E^(-y)) (-1+(E^y)) (-(E^y) y (Subscript[g, 11])[y]-z (Subscript[g, 11])[z]+(E^y) z (Subscript[g, 11])[z]+(E^y) (y^2) (Subscript[g, 13])[y]+(z^2) (Subscript[g, 13])[z]-(E^y) (z^2) (Subscript[g, 13])[z]))/(y^2))

R3 on (Subscript[u, 3])

R3u3=R3[(Subscript[u, 3])]/.  {(Subscript[b, 1])->x, (Subscript[b, 2])->y, (Subscript[b, 3])->z};

The following were obtained by watching Dynamic[R3u3 // Simp] and repeatedly simplifying it:

Simplify[Coefficient[R3u3,ϵ (Subscript[u, 3])(Subscript[w, 3])] /.{(Subscript[u, _])->0, (Subscript[w, _])->0, (Subscript[c, _])->0}]

(Subscript[f, 41])[x_,y_] := (Subscript[g, 14])[y](-1+(E^x))

Simplify[Coefficient[R3u3,ϵ (Subscript[c, 1])(Subscript[u, 1])] /.{(Subscript[u, _])->0, (Subscript[w, _])->0, (Subscript[c, _])->0}]

(Subscript[f, 45])[x_,y_ ]:= (Subscript[g, 15])[x]

Simplify[Coefficient[R3u3,ϵ (Subscript[w, 1])(Subscript[u, 1])] /.{(Subscript[u, _])->0, (Subscript[w, _])->0, (Subscript[c, _])->0}]

(Subscript[f, 38])[x_,y_ ]:= (Subscript[g, 16])[x]

tt1=Simplify[Coefficient[R3u3,ϵ (Subscript[c, 2])] /.{(Subscript[u, _])->0, (Subscript[w, _])->0, (Subscript[c, _])->0}]

Solve[tt1==0, (Subscript[g, 3])[y]]

(Subscript[g, 3])[y_]:=-2 y ((E^y) (Subscript[g, 5])[y]-(Subscript[g, 14])[y]+(E^y) (Subscript[g, 14])[y]+(Subscript[g, 16])[y])

tt1=Simplify[Coefficient[R3u3,ϵ (Subscript[u, 1])(Subscript[u, 2])(Subscript[w, 2])] /.{(Subscript[u, _])->0, (Subscript[w, _])->0, (Subscript[c, _])->0}]

Solve[tt1==0, (Subscript[f, 32])[x,y]]

(Subscript[f, 32])[x_,y_]:=(1/((-1+(E^y)) (x^2) y))(-x+(E^x) x+(E^y) x-(E^(x+y)) x-y+(E^x) y+(E^y) y-(E^(x+y)) y-x y+(E^(x+y)) x y+x (y^2) (Subscript[g, 1])[y]-(E^x) x (y^2) (Subscript[g, 1])[y]-(E^y) x (y^2) (Subscript[g, 6])[y]+(E^(x+y)) x (y^2) (Subscript[g, 6])[y]-x (y^2) (Subscript[g, 9])[y]+(E^x) x (y^2) (Subscript[g, 9])[y]+x (y^3) (Subscript[g, 15])[y]-(E^x) x (y^3) (Subscript[g, 15])[y])

tt1=Simplify[Coefficient[R3u3,ϵ ] /.{(Subscript[u, _])->0, (Subscript[w, _])->0, (Subscript[c, _])->0}]

tt2=Simplify[(tt1/((E^(-x-y)) z))]

D[tt2,z]//Simplify

Derivative[0,1][(Subscript[f, 6])][x,z]==g[z](-1+(E^x))

(Subscript[f, 6])[x_,z_] := (-1+(E^x))(Subscript[g, 17])[z]+(Subscript[g, 18])[x]

D[tt2,z]//Simplify

tt1=Simplify[Coefficient[R3u3,ϵ ] /.{(Subscript[u, _])->0, (Subscript[w, _])->0, (Subscript[c, _])->0}]

Solve[tt1==0, (Subscript[g, 18])[y]]

(Subscript[g, 18])[y_]:=-(E^y) (Subscript[g, 8])[y]+(Subscript[g, 17])[y]-(E^y) (Subscript[g, 17])[y]

tt1=Simplify[Coefficient[R3w1,ϵ (Subscript[w, 3])] /.{(Subscript[u, _])->0, (Subscript[w, _])->0, (Subscript[c, _])->0}]

tt2=Simplify[D[tt1,z]]

Derivative[0,1][(Subscript[f, 20])][x,z]==(((-1+(E^x))g[z])/x)

(Subscript[f, 20])[x_,z_] := (((-1+(E^x))(Subscript[g, 19])[z])/x)+(Subscript[g, 20])[x]

tt2=Simplify[D[tt1,z]]

tt1=Simplify[Coefficient[R3w1,ϵ (Subscript[w, 3])] /.{(Subscript[u, _])->0, (Subscript[w, _])->0, (Subscript[c, _])->0}]

Solve[tt1==0, (Subscript[g, 10])[y]]

(Subscript[g, 10])[y_]:=y (Subscript[g, 1])[y]-(E^y) (Subscript[g, 7])[y]+(y^2) (Subscript[g, 15])[y]-(Subscript[g, 19])[y]+(E^y) (Subscript[g, 19])[y]+y (Subscript[g, 20])[y]

Table[R3[(Subscript[y, i])]//Simp, {y,{c,u,w}}, {i,3}]

Most General R

ρ0[1,2] // Simp

Special Rules 1

(Subscript[u, 1]) // R[1,2] // Simp

(Subscript[u, 2]) // R[1,2] // Simp

SR1=ReplaceAll[{(Subscript[g, 1|5|6|7|8|11|12|13|14|15|17|19|20])[y_] :>0, (Subscript[f, _])[__]:> 0,(Subscript[g, 16])[y_] :> (E^y)-1, (Subscript[g, 9])[y_]:> -((E^y)/y)}];

ρ0[1,2] //SR1// Simp

(Subscript[u, 1]) // R[1,2] // SR1// Simp

(Subscript[u, 2]) // R[1,2] // SR1// Simp

(Subscript[w, 1]) // R[1,2] // SR1// Simp

(Subscript[w, 2]) // R[1,2] // SR1// Simp

(Subscript[c, 1]) // R[1,2] // SR1// Simp

(Subscript[c, 2]) // R[1,2] // SR1// Simp

Special Rules 2

SR2[ℰ_]:= ℰ /. {(Subscript[u, i_]):>(Subscript[b, i])(Subscript[u, i]),
(Subscript[g, 1])[y_]:>((((E^y)-1))/(y^2))(Subscript[gg, 1])[y],(Subscript[g, 16])[y_]:>((E^y)-1)(Subscript[gg, 2])[y]-(Subscript[g, 5])[y],(Subscript[g, 6])[x_]:>(Subscript[gg, 6])[x]/x, (Subscript[g, 9])[x_]:>(Subscript[gg, 9])[x]/x, (Subscript[g, 15])[x_]:>(Subscript[gg, 15])[x]/(x^2),(Subscript[g, 19])[x_]:>(Subscript[gg, 19])[x]/x
} /. {(Subscript[g, 5])[x_]:>(Subscript[gg, 5])[x]/x, (Subscript[g, 11])[x_]:>x (Subscript[g, 13])[x]};

Problem. The following cannot both be trigonometrized:

{Coefficient[((Subscript[u, 1])/(Subscript[b, 1])) // R[1,2] // SR2// Simp, ϵ (Subscript[u, 1]^2) (Subscript[w, 2])], Coefficient[(Subscript[w, 2]) // R[1,2] // SR2// Simp, ϵ (Subscript[u, 1])(Subscript[w, 2]^2)]}

((Subscript[u, 1])/(Subscript[b, 1])) // R[1,2] // SR2// Simp

((Subscript[u, 2])/(Subscript[b, 2])) // R[1,2] // SR2// Simp

(Subscript[w, 1]) // R[1,2] // SR2// Simp

(Subscript[w, 2]) // R[1,2] // SR2// Simp

(Subscript[c, 1]) // R[1,2] // SR2// Simp

(Subscript[c, 2]) // R[1,2] // SR2// Simp

ρ0[1,2] //SR2// Simp

Special Rules 3

First round of replacements below is the most general that makes the u-action trigonometric. The second round is arbitrary.

SR3[ℰ_]:= ℰ /. {(Subscript[u, i_]):>(Subscript[b, i])(Subscript[u, i]),
(Subscript[g, 1])[y_]:>((((E^y)-1))/(y^2))+((((E^y)-1)(Subscript[gg, 1])[y])/y), (Subscript[g, 5])[x_]:>(Subscript[gg, 5])[x]/x, (Subscript[g, 6])[x_]:>((((E^x)-1)(Subscript[gg, 6])[x])/x), (Subscript[g, 9])[x_]:>((((E^x)-1)(Subscript[gg, 9])[x])/x), (Subscript[g, 11])[y_] :> y (Subscript[g, 13])[y]-(y^(-1))(Subscript[gg, 11])[y], (Subscript[g, 14])[x_]:>(Subscript[gg, 14])[x]/x, (Subscript[g, 15])[x_]:>((((E^x)-1)(Subscript[gg, 15])[x]+(E^x))/(x^2)),(Subscript[g, 16])[y_]:>(1/y)(-(Subscript[gg, 5])[y]+((E^y)-1)(Subscript[gg, 16])[y]), (Subscript[g, 20])[x_]:>((1-(E^x))/(x^2))+(Subscript[gg, 20])[x]/x
} /. {(Subscript[g, 7|8|12|13|17|19])[_]-> 0, (Subscript[gg, 1|5|6|9|11|14|15|16|20])[_]->0, (Subscript[f, 16|21|42|46|50])[__]->0};

((Subscript[u, 1])/(Subscript[b, 1])) // R[1,2] // SR3// Simp

Exponent[((Subscript[u, 1])/(Subscript[b, 1])) // R[1,2] // SR3, #, MinMax@*List]& /@ {(Subscript[b, 1]),(Subscript[b, 2])}

((Subscript[u, 2])/(Subscript[b, 2])) // R[1,2] // SR3// Simp

Exponent[((Subscript[u, 2])/(Subscript[b, 2])) // R[1,2] // SR3, #, MinMax@*List]& /@ {(Subscript[b, 1]),(Subscript[b, 2])}

(Subscript[w, 1]) // R[1,2] // SR3// Simp

(Subscript[w, 2]) // R[1,2] // SR3// Simp

(Subscript[c, 1]) // R[1,2] // SR3// Simp

(Subscript[c, 2]) // R[1,2] // SR3// Simp

ρ0[1,2] //SR3// Simp