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

SetDirectory@"C:\\drorbn\\AcademicPensieve\\Projects\\OneCo-1604";
<< Global.m;
Simp=Expand;
ExportButton

Finding R

Total[MapIndexed[(#1 /. (Subscript[ff, _]):>(Subscript[ff, #2[[1]]]))& , DeleteCases[UUBasis[{j,k},ff], UU[_β]|UU[_a]|UU[_δβ]]]]

ρ0[j_,k_]:=UU[δa[(Subscript[ff, 1])[(Subscript[b, j]),(Subscript[b, k])],ç,j]+δa[(Subscript[ff, 2])[(Subscript[b, j]),(Subscript[b, k])],ç,k]+δa[(Subscript[ff, 3])[(Subscript[b, j]),(Subscript[b, k])],j,j]+δa[(Subscript[ff, 4])[(Subscript[b, j]),(Subscript[b, k])],j,k]+δa[(Subscript[ff, 5])[(Subscript[b, j]),(Subscript[b, k])],k,j]+δa[(Subscript[ff, 6])[(Subscript[b, j]),(Subscript[b, k])],k,k]+δaa[(Subscript[ff, 7])[(Subscript[b, j]),(Subscript[b, k])],ç,j,j,j]+δaa[(Subscript[ff, 8])[(Subscript[b, j]),(Subscript[b, k])],ç,j,j,k]+δaa[(Subscript[ff, 9])[(Subscript[b, j]),(Subscript[b, k])],ç,k,j,j]+δaa[(Subscript[ff, 10])[(Subscript[b, j]),(Subscript[b, k])],ç,k,j,k]+δaa[(Subscript[ff, 11])[(Subscript[b, j]),(Subscript[b, k])],ç,j,k,j]+δaa[(Subscript[ff, 12])[(Subscript[b, j]),(Subscript[b, k])],ç,j,k,k]+δaa[(Subscript[ff, 13])[(Subscript[b, j]),(Subscript[b, k])],ç,k,k,j]+δaa[(Subscript[ff, 14])[(Subscript[b, j]),(Subscript[b, k])],ç,k,k,k]+δaa[(Subscript[ff, 15])[(Subscript[b, j]),(Subscript[b, k])],j,j,j,j]+δaa[(Subscript[ff, 16])[(Subscript[b, j]),(Subscript[b, k])],j,j,j,k]+δaa[(Subscript[ff, 17])[(Subscript[b, j]),(Subscript[b, k])],j,k,j,k]+δaa[(Subscript[ff, 18])[(Subscript[b, j]),(Subscript[b, k])],j,j,k,j]+δaa[(Subscript[ff, 19])[(Subscript[b, j]),(Subscript[b, k])],j,j,k,k]+δaa[(Subscript[ff, 20])[(Subscript[b, j]),(Subscript[b, k])],j,k,k,k]+δaa[(Subscript[ff, 21])[(Subscript[b, j]),(Subscript[b, k])],k,j,k,j]+δaa[(Subscript[ff, 22])[(Subscript[b, j]),(Subscript[b, k])],k,j,k,k]+δaa[(Subscript[ff, 23])[(Subscript[b, j]),(Subscript[b, k])],k,k,k,k]]

R[j_,k_] := R[j,k]=Ea[j,k]**TSD[{
j->UU[a[1,j,h∞]]+bb[j,k][ρ0[j,k],UU[a[1,j,h∞]]],
k->UU[a[1,k,h∞]]+bb[j,k][ρ0[j,k],UU[a[1,k,h∞]]]
}];

lhs=R[1,2]**R[1,3]**R[2,3];
rhs=R[2,3]**R[1,3]**R[1,2];

Simp=Simplify

The following were obtained by watching Dynamic[(Subscript[lhs, 1])-(Subscript[rhs, 1])] and repeatedly simplifying it:

Coefficient[(Subscript[lhs, 1])-(Subscript[rhs, 1]), δaa[ç,h∞,2,1]]

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

Coefficient[(Subscript[lhs, 1])-(Subscript[rhs, 1]), δa[3,h∞]]

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

Coefficient[(Subscript[lhs, 1])-(Subscript[rhs, 1]), δaa[1,2,3,h∞]]

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

Coefficient[(Subscript[lhs, 1])-(Subscript[rhs, 1]), δaa[3,3,3,h∞]]

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

Coefficient[(Subscript[lhs, 1])-(Subscript[rhs, 1]), δaa[1,1,3,h∞]]

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

Coefficient[(Subscript[lhs, 1])-(Subscript[rhs, 1]), δaa[2,3,3,h∞]] // Simplify

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

Coefficient[(Subscript[lhs, 1])-(Subscript[rhs, 1]), δaa[1,3,1,h∞]] // Simplify

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

The following were obtained by watching Dynamic[(Subscript[lhs, 2])-(Subscript[rhs, 2])] and repeatedly simplifying it:

Coefficient[(Subscript[lhs, 2])-(Subscript[rhs, 2]), δaa[1,1,1,h∞]] // Simplify

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

Coefficient[(Subscript[lhs, 2])-(Subscript[rhs, 2]), δa[1,h∞]] // Simplify

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

Coefficient[(Subscript[lhs, 2])-(Subscript[rhs, 2]), δaa[ç,3,3,h∞]] // Simplify

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

Coefficient[(Subscript[lhs, 2])-(Subscript[rhs, 2]), δaa[2,3,2,h∞]] // Simplify

(Subscript[ff, 10])[x_,y_] := -x (Subscript[ff, 17])[x,y]

Coefficient[(Subscript[lhs, 2])-(Subscript[rhs, 2]), δaa[ç,h∞,1,3]] // Simplify

(Subscript[gg, 1])[x_]=(Subscript[cc, 1])/x;

t1=Coefficient[(Subscript[lhs, 2])-(Subscript[rhs, 2]), δaa[1,3,2,h∞]] // Simplify

Simplify[(Subscript[ff, 17])[x,y]/.Solve[t1==0 /. {(Subscript[b, 1])->x, (Subscript[b, 2])->y} , (Subscript[ff, 17])[x,y]]]

(Subscript[ff, 17])[x_,y_] := -(((E^(-x)) (2+(E^x) (-2+x)+x+(-1+(E^x)) x (Subscript[cc, 1])))/(2 (x^3)));

The following were obtained by watching Dynamic[(Subscript[lhs, 3])-(Subscript[rhs, 3])] and repeatedly simplifying it:

Coefficient[(Subscript[lhs, 3])-(Subscript[rhs, 3]), δaa[2,2,2,h∞]] // Simplify

(Subscript[ff, 14])[x_,y_] := -x (Subscript[ff, 20])[x,y]

Coefficient[(Subscript[lhs, 3])-(Subscript[rhs, 3]), δaa[1,1,1,h∞]] // Simplify

(Subscript[ff, 16])[x_,y_]:=(Subscript[gg, 4])[x];

Coefficient[(Subscript[lhs, 3])-(Subscript[rhs, 3]), δaa[1,1,2,h∞]] // Simplify

(Subscript[ff, 9])[x_,y_]:=(Subscript[gg, 5])[x];

Coefficient[(Subscript[lhs, 3])-(Subscript[rhs, 3]), δaa[1,3,3,h∞]] // Simplify

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

Coefficient[(Subscript[lhs, 3])-(Subscript[rhs, 3]), δa[2,h∞]] // Simplify

((Subscript[b, 1])(Subscript[ff, 4])[(Subscript[b, 1]),(Subscript[b, 2])]+(Subscript[ff, 2])[(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[b, 1])->x, (Subscript[b, 2])->y, (Subscript[b, 3])->z}

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

t2=Coefficient[(Subscript[lhs, 3])-(Subscript[rhs, 3]), δaa[1,2,2,h∞]] // Simplify

Simplify[(Subscript[gg, 3])[y]/.Solve[t2==0 /. {(Subscript[b, 1])->x, (Subscript[b, 2])->y} , (Subscript[gg, 3])[y]]]

(Subscript[gg, 3])[y_] := ((2-2 (E^y)+y+(E^y) y-(1+(E^y)) y (Subscript[cc, 1])-2 (E^y) (y^2) (Subscript[gg, 5])[y]-2 (y^2) (Subscript[gg, 6])[y]+2 (E^y) (y^2) (Subscript[gg, 6])[y])/(2 (y^2)));

t3=Coefficient[(Subscript[lhs, 3])-(Subscript[rhs, 3]), δa[1,h∞]]

t4=(2 (Subscript[b, 1]) ((Subscript[b, 2])/(Subscript[b, 3]))t3 /. {(Subscript[b, 1])->x, (Subscript[b, 2])->y, (Subscript[b, 3])->z}) // Simplify

D[t4,z]/(2y) // Simplify

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

t5=Coefficient[(Subscript[lhs, 3])-(Subscript[rhs, 3]), δa[1,h∞]]/. {(Subscript[b, 1])->x, (Subscript[b, 2])->y}

Solve[t5==0, (Subscript[gg, 9])[y]]

(Subscript[gg, 9])[y_] := (1/(2 (-1+(E^y)) y))(2-2 (E^y)+y+(E^y) y-y (Subscript[cc, 1])+(E^y) y (Subscript[cc, 1])+2 y (Subscript[gg, 2])[y]+2 (y^2) (Subscript[gg, 6])[y]-2 (E^y) (y^2) (Subscript[gg, 6])[y]+2 (E^y) y (Subscript[gg, 7])[y]-2 (E^y) (y^2) (Subscript[gg, 8])[y]);

Table[(Subscript[lhs, i])-(Subscript[rhs, i]),{i,3}]

UU@β[f[(Subscript[b, 1]),(Subscript[b, 2]),(Subscript[b, 3])]] // R[1,2] // R[1,3] // R[2,3]

UU@β[f[(Subscript[b, 1]),(Subscript[b, 2]),(Subscript[b, 3])]] // R[2,3] // R[1,3] // R[1,2]

(UU@β[f[(Subscript[b, 1]),(Subscript[b, 2]),(Subscript[b, 3])]] // R[1,2] // R[1,3] // R[2,3])-(UU@β[f[(Subscript[b, 1]),(Subscript[b, 2]),(Subscript[b, 3])]] // R[2,3] // R[1,3] // R[1,2])

Table[(UU@a[f[(Subscript[b, 1]),(Subscript[b, 2]),(Subscript[b, 3])], i,h∞] // R[1,2] // R[1,3] // R[2,3])-(UU@a[f[(Subscript[b, 1]),(Subscript[b, 2]),(Subscript[b, 3])], i,h∞]// R[2,3] // R[1,3] // R[1,2]), {i,3}]

Table[CF[ÅForm[(Subscript[(R[1,2]**R[1,3]), i])-(Subscript[(R[1,3]**R[1,2]), i])]], {i,3}]

Table[CF[ÅForm[(Subscript[(R[1,2]**R[1,3]), i])-(Subscript[(R[1,3]**R[1,2]), i]) /. {(Subscript[gg, 2|4|5|7])[_]->0, (Subscript[gg, 6])[x_]:>((2-x)/(2(x^2))), (Subscript[gg, 8])[x_]:> 1/x, (Subscript[cc, 1])->0}]], {i,3}]

ρ0[1,2]

Table[CF@(Subscript[R[1,2], i]),{i,2}]

Table[CF[(Subscript[R[1,2], i]) /. {(Subscript[gg, 2|4|5|6|7|8])[_]->0}],{i,2}]

Table[CF[(Subscript[R[1,2], i]) /. {(Subscript[gg, 2|4|5|6|7|8])[_]->0}],{i,2}] // ÅForm

Table[CF[(Subscript[R[1,2], i]) /. {(Subscript[gg, 2|4|5|6|7|8])[_]->0, (Subscript[cc, 1])->1}],{i,2}]

Table[CF[(Subscript[R[1,2], i]) /. {(Subscript[gg, 2|4|5|6|7|8])[_]->0, (Subscript[cc, 1])->1}],{i,2}] // ÅForm

Table[CF[(Subscript[R[1,2], i]) /. {(Subscript[gg, 2|4|5|7])[_]->0}],{i,2}]

Table[CF[(Subscript[R[1,2], i]) /. {(Subscript[gg, 2|4|5|7])[_]->0, (Subscript[cc, 1])->1}],{i,2}]

Table[CF[(Subscript[R[1,2], i]) /. {(Subscript[gg, 2|4|5|7])[_]->0, (Subscript[cc, 1])->1, (Subscript[gg, 6])[x_]:>(1/(2(x^2)))}],{i,2}]

Table[CF[(Subscript[R[1,2], i]) /. {(Subscript[gg, 2|4|5|7])[_]->0, (Subscript[gg, 6])[x_]:>((2-x)/(2(x^2))), (Subscript[cc, 1])->0}],{i,2}]

Table[CF[(Subscript[R[1,2], i]) /. {(Subscript[gg, 2|4|5|7])[_]->0, (Subscript[gg, 6])[x_]:>((2-x)/(2(x^2))), (Subscript[gg, 8])[x_]:> 1/x,(Subscript[cc, 1])->0}],{i,2}]//ÅForm

Table[CF[(Subscript[R[1,2], i]) /. {(Subscript[gg, 2|4|5|7])[_]->0, (Subscript[gg, 6])[x_]:>(1/(2(x^2))), (Subscript[gg, 8])[x_]:> 1/x, (Subscript[cc, 1])->1}],{i,2}]

Table[CF[(Subscript[R[1,2], i]) /. {(Subscript[gg, 2|4|5|7])[_]->0, (Subscript[gg, 6])[x_]:>(1/(2(x^2))), (Subscript[gg, 8])[x_]:> 1/x, (Subscript[cc, 1])->1}],{i,2}]// ÅForm

Column@Table[x->CF[ÅForm[(δaForm@UU@x)//R[1,2]//R[2,3]//R[2,1]] /. {(Subscript[gg, 2|4|5|7])[_]->0, (Subscript[gg, 6])[x_]:>((2-x)/(2(x^2))), (Subscript[gg, 8])[x_]:> 1/x, (Subscript[cc, 1])->0}],
{x,{β[f[(Subscript[b, 1]),(Subscript[b, 2])]], a[1,1,h∞], a[1,2,h∞], ao[1,1,h∞], ao[1,2,h∞], ca[1,h∞,1,3], ca[1,h∞,2,3], ca[1,h∞,0,1],ca[1,h∞,0,2], aao[1,1,3,1,h∞],aao[1,3,4,2,h∞]}}]

Column@Table[x->CF[ÅForm[(δaForm@UU@x)//R[1,2]] /. {(Subscript[gg, 2|4|5|7])[_]->0, (Subscript[gg, 6])[x_]:>((2-x)/(2(x^2))), (Subscript[gg, 8])[x_]:> 1/x, (Subscript[cc, 1])->0}],
{x,{β[f[(Subscript[b, 1]),(Subscript[b, 2])]], a[1,1,h∞], a[1,2,h∞], a[f[(Subscript[b, 1]),(Subscript[b, 2])],1,h∞], a[f[(Subscript[b, 1]),(Subscript[b, 2])],2,h∞],c[1,h∞],ao[1,1,h∞],ao[1,2,h∞],ca[1,1,1,h∞],ca[1,2,1,h∞],ca[1,h∞,1,1],ca[1,h∞,1,2],ca[1,1,2,h∞],ca[1,2,2,h∞],ca[1,h∞,2,1],ca[1,h∞,2,2],aao[1,1,1,1,h∞],aao[1,1,2,1,h∞],aao[1,1,1,2,h∞],aao[1,1,2,2,h∞],aao[1,2,1,2,h∞],aao[1,2,2,2,h∞]}}]