Pensieve header: Solving for caps and cups for NOE-1, t variables.

From Turaev's "Operator Invariants..." and Ohtsuki's "Quantum Invariants":

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

Solution to all-but-one equations, as found on 160817 at YB4NOE-1t.nb:

EC0={(Subscript[f, 1])[x_,z_]:>(1/2) (-2 (Subscript[f, 6])[x,z]+2 x (Subscript[f, 6])[x,z]+2 (Subscript[f, 20])[x,z]-(Subscript[g, 5])[x]+4 (Subscript[g, 6])[x]-12 x (Subscript[g, 6])[x]+12 (x^2) (Subscript[g, 6])[x]-4 (x^3) (Subscript[g, 6])[x]+(Subscript[g, 8])[z]),(Subscript[f, 2])[x_,y_]:>-(Subscript[f, 9])[x,y]+y (Subscript[f, 9])[x,y]+(Subscript[f, 26])[x,y]-2 y (Subscript[f, 26])[x,y]+(y^2) (Subscript[f, 26])[x,y]+(Subscript[g, 7])[x],(Subscript[f, 3])[x_,z_]:>(Subscript[f, 18])[x,z]-2 x (Subscript[f, 18])[x,z]+(x^2) (Subscript[f, 18])[x,z],(Subscript[f, 4])[x_,z_]:>-(Subscript[f, 15])[x,z]-(Subscript[g, 1])[z],(Subscript[f, 5])[x_,y_]:>(Subscript[f, 26])[x,y]-2 y (Subscript[f, 26])[x,y]+(y^2) (Subscript[f, 26])[x,y],(Subscript[f, 7])[x_,z_]:>(Subscript[f, 6])[x,z]-x (Subscript[f, 6])[x,z]+(Subscript[g, 9])[x]+(Subscript[g, 10])[z],(Subscript[f, 8])[x_,z_]:>0,(Subscript[f, 10])[x_,z_]:>2 (-(Subscript[f, 18])[x,z]+x (Subscript[f, 18])[x,z]),(Subscript[f, 11])[x_,y_]:>-2 (Subscript[f, 18])[x,y]+4 x (Subscript[f, 18])[x,y]-2 (x^2) (Subscript[f, 18])[x,y]-(Subscript[g, 5])[x],(Subscript[f, 12])[x_,z_]:>0,(Subscript[f, 13])[x_,z_]:>-(Subscript[f, 23])[x,z]-(Subscript[g, 2])[z],(Subscript[f, 14])[x_,z_]:>((-(Subscript[f, 15])[x,z]+(Subscript[g, 3])[z])/(-1+x)),(Subscript[f, 15])[y_,z_]:>(1/y)(2-y (Subscript[f, 23])[y,z]+y z (Subscript[f, 23])[y,z]-(Subscript[g, 1])[y]-y (Subscript[g, 1])[z]-y (Subscript[g, 2])[z]+y z (Subscript[g, 2])[z]-y (Subscript[g, 3])[y]-(Subscript[g, 5])[y]+y (Subscript[g, 5])[y]),(Subscript[f, 16])[x_,z_]:>0,(Subscript[f, 17])[x_,z_]:>2 (-(Subscript[f, 26])[x,z]+z (Subscript[f, 26])[x,z]),(Subscript[f, 18])[x_,y_]:>((-(Subscript[f, 19])[x,y]-4 (Subscript[g, 6])[x]+8 x (Subscript[g, 6])[x]-4 (x^2) (Subscript[g, 6])[x])/(2 (-1+x))),(Subscript[f, 19])[x_,y_]:>(1/((-1+x) (-1+y)))(1+2 (Subscript[f, 20])[x,y]-2 y (Subscript[f, 20])[x,y]-(Subscript[g, 5])[x]+y (Subscript[g, 5])[x]-(Subscript[g, 5])[y]+y (Subscript[g, 5])[y]-4 (Subscript[g, 6])[y]+16 y (Subscript[g, 6])[y]-24 (y^2) (Subscript[g, 6])[y]+16 (y^3) (Subscript[g, 6])[y]-4 (y^4) (Subscript[g, 6])[y]+y (Subscript[h, 1])[]),(Subscript[f, 21])[x_,z_]:>0,(Subscript[f, 22])[x_,z_]:>((-(Subscript[f, 23])[x,z]+(Subscript[g, 4])[z])/(-1+x)),(Subscript[f, 24])[x_,z_]:>0,(Subscript[f, 25])[x_,z_]:>0,(Subscript[g, 1])[y_]:>-(Subscript[g, 2])[y]+y (Subscript[g, 2])[y]-(Subscript[g, 3])[y]-(Subscript[g, 4])[y]+y (Subscript[g, 4])[y]-(Subscript[h, 1])[],(Subscript[g, 3])[y_]:>(1/(2 (-1+y)))(2+2 (Subscript[g, 4])[y]-4 y (Subscript[g, 4])[y]+2 (y^2) (Subscript[g, 4])[y]-2 (Subscript[g, 5])[y]+2 y (Subscript[g, 5])[y]-8 (Subscript[g, 6])[y]+32 y (Subscript[g, 6])[y]-48 (y^2) (Subscript[g, 6])[y]+32 (y^3) (Subscript[g, 6])[y]-8 (y^4) (Subscript[g, 6])[y]+(Subscript[h, 1])[]+y (Subscript[h, 1])[]),(Subscript[g, 10])[y_]:>(1/(2 (1-2 y+(y^2))))(1+(Subscript[g, 5])[y]-3 y (Subscript[g, 5])[y]+2 (y^2) (Subscript[g, 5])[y]-4 (Subscript[g, 6])[y]+16 y (Subscript[g, 6])[y]-24 (y^2) (Subscript[g, 6])[y]+16 (y^3) (Subscript[g, 6])[y]-4 (y^4) (Subscript[g, 6])[y]-2 y (Subscript[g, 7])[y]+2 (y^2) (Subscript[g, 7])[y]-(Subscript[g, 8])[y]+y (Subscript[g, 8])[y]-2 (Subscript[g, 9])[y]+4 y (Subscript[g, 9])[y]-2 (y^2) (Subscript[g, 9])[y]+y (Subscript[h, 1])[])};

Length[EC0]

Rp[i_,j_]:=𝔼[1, (Subscript[b, i])(Subscript[c, j]),(Subscript[u, i])(Subscript[w, j]),(Subscript[c, i]) (Subscript[f, 1])[(Subscript[t, i]),(Subscript[t, j])]+(Subscript[c, j]) (Subscript[f, 2])[(Subscript[t, i]),(Subscript[t, j])]+(Subscript[c, i]^2) (Subscript[f, 3])[(Subscript[t, i]),(Subscript[t, j])]+(Subscript[c, i]) (Subscript[c, j]) (Subscript[f, 4])[(Subscript[t, i]),(Subscript[t, j])]+(Subscript[c, j]^2) (Subscript[f, 5])[(Subscript[t, i]),(Subscript[t, j])]+(Subscript[u, i]) (Subscript[w, i]) (Subscript[f, 6])[(Subscript[t, i]),(Subscript[t, j])]+(Subscript[u, i]) (Subscript[w, j]) (Subscript[f, 7])[(Subscript[t, i]),(Subscript[t, j])]+(Subscript[u, j]) (Subscript[w, i]) (Subscript[f, 8])[(Subscript[t, i]),(Subscript[t, j])]+(Subscript[u, j]) (Subscript[w, j]) (Subscript[f, 9])[(Subscript[t, i]),(Subscript[t, j])]+(Subscript[c, i]) (Subscript[u, i]) (Subscript[w, i]) (Subscript[f, 10])[(Subscript[t, i]),(Subscript[t, j])]+(Subscript[c, i]) (Subscript[u, i]) (Subscript[w, j]) (Subscript[f, 11])[(Subscript[t, i]),(Subscript[t, j])]+(Subscript[c, i]) (Subscript[u, j]) (Subscript[w, i]) (Subscript[f, 12])[(Subscript[t, i]),(Subscript[t, j])]+(Subscript[c, i]) (Subscript[u, j]) (Subscript[w, j]) (Subscript[f, 13])[(Subscript[t, i]),(Subscript[t, j])]+(Subscript[c, j]) (Subscript[u, i]) (Subscript[w, i]) (Subscript[f, 14])[(Subscript[t, i]),(Subscript[t, j])]+(Subscript[c, j]) (Subscript[u, i]) (Subscript[w, j]) (Subscript[f, 15])[(Subscript[t, i]),(Subscript[t, j])]+(Subscript[c, j]) (Subscript[u, j]) (Subscript[w, i]) (Subscript[f, 16])[(Subscript[t, i]),(Subscript[t, j])]+(Subscript[c, j]) (Subscript[u, j]) (Subscript[w, j]) (Subscript[f, 17])[(Subscript[t, i]),(Subscript[t, j])]+(Subscript[u, i]^2) (Subscript[w, i]^2) (Subscript[f, 18])[(Subscript[t, i]),(Subscript[t, j])]+(Subscript[u, i]^2) (Subscript[w, i]) (Subscript[w, j]) (Subscript[f, 19])[(Subscript[t, i]),(Subscript[t, j])]+(Subscript[u, i]^2) (Subscript[w, j]^2) (Subscript[f, 20])[(Subscript[t, i]),(Subscript[t, j])]+(Subscript[u, i]) (Subscript[u, j]) (Subscript[w, i]^2) (Subscript[f, 21])[(Subscript[t, i]),(Subscript[t, j])]+(Subscript[u, i]) (Subscript[u, j]) (Subscript[w, i]) (Subscript[w, j]) (Subscript[f, 22])[(Subscript[t, i]),(Subscript[t, j])]+(Subscript[u, i]) (Subscript[u, j]) (Subscript[w, j]^2) (Subscript[f, 23])[(Subscript[t, i]),(Subscript[t, j])]+(Subscript[u, j]^2) (Subscript[w, i]^2) (Subscript[f, 24])[(Subscript[t, i]),(Subscript[t, j])]+(Subscript[u, j]^2) (Subscript[w, i]) (Subscript[w, j]) (Subscript[f, 25])[(Subscript[t, i]),(Subscript[t, j])]+(Subscript[u, j]^2) (Subscript[w, j]^2) (Subscript[f, 26])[(Subscript[t, i]),(Subscript[t, j])]]

Rp[1,2]

Short[t1=Rp[1,2](Rp[3,4]Rp[5,6] // m[3,5,x])//m[1,6,y]//m[2,4,z]]

Short[t2=(Rp[1,2]Rp[3,4]//m[1,3,x])Rp[5,6]//m[2,5,y]//m[4,6,z], 5]

t3=(t1≡t2)//.EC0

Together[t3]

Finding Rm

Rm[i_,j_]:=𝔼[1,-(Subscript[b, i])(Subscript[c, j]),-(Subscript[t, i]^(-1))(Subscript[u, i])(Subscript[w, j]),(Subscript[c, i]) (Subscript[g, 1])[(Subscript[t, i]),(Subscript[t, j])]+(Subscript[c, j]) (Subscript[g, 2])[(Subscript[t, i]),(Subscript[t, j])]+(Subscript[c, i]^2) (Subscript[g, 3])[(Subscript[t, i]),(Subscript[t, j])]+(Subscript[c, i]) (Subscript[c, j]) (Subscript[g, 4])[(Subscript[t, i]),(Subscript[t, j])]+(Subscript[c, j]^2) (Subscript[g, 5])[(Subscript[t, i]),(Subscript[t, j])]+(Subscript[u, i]) (Subscript[w, i]) (Subscript[g, 6])[(Subscript[t, i]),(Subscript[t, j])]+(Subscript[u, i]) (Subscript[w, j]) (Subscript[g, 7])[(Subscript[t, i]),(Subscript[t, j])]+(Subscript[u, j]) (Subscript[w, i]) (Subscript[g, 8])[(Subscript[t, i]),(Subscript[t, j])]+(Subscript[u, j]) (Subscript[w, j]) (Subscript[g, 9])[(Subscript[t, i]),(Subscript[t, j])]+(Subscript[c, i]) (Subscript[u, i]) (Subscript[w, i]) (Subscript[g, 10])[(Subscript[t, i]),(Subscript[t, j])]+(Subscript[c, i]) (Subscript[u, i]) (Subscript[w, j]) (Subscript[g, 11])[(Subscript[t, i]),(Subscript[t, j])]+(Subscript[c, i]) (Subscript[u, j]) (Subscript[w, i]) (Subscript[g, 12])[(Subscript[t, i]),(Subscript[t, j])]+(Subscript[c, i]) (Subscript[u, j]) (Subscript[w, j]) (Subscript[g, 13])[(Subscript[t, i]),(Subscript[t, j])]+(Subscript[c, j]) (Subscript[u, i]) (Subscript[w, i]) (Subscript[g, 14])[(Subscript[t, i]),(Subscript[t, j])]+(Subscript[c, j]) (Subscript[u, i]) (Subscript[w, j]) (Subscript[g, 15])[(Subscript[t, i]),(Subscript[t, j])]+(Subscript[c, j]) (Subscript[u, j]) (Subscript[w, i]) (Subscript[g, 16])[(Subscript[t, i]),(Subscript[t, j])]+(Subscript[c, j]) (Subscript[u, j]) (Subscript[w, j]) (Subscript[g, 17])[(Subscript[t, i]),(Subscript[t, j])]+(Subscript[u, i]^2) (Subscript[w, i]^2) (Subscript[g, 18])[(Subscript[t, i]),(Subscript[t, j])]+(Subscript[u, i]^2) (Subscript[w, i]) (Subscript[w, j]) (Subscript[g, 19])[(Subscript[t, i]),(Subscript[t, j])]+(Subscript[u, i]^2) (Subscript[w, j]^2) (Subscript[g, 20])[(Subscript[t, i]),(Subscript[t, j])]+(Subscript[u, i]) (Subscript[u, j]) (Subscript[w, i]^2) (Subscript[g, 21])[(Subscript[t, i]),(Subscript[t, j])]+(Subscript[u, i]) (Subscript[u, j]) (Subscript[w, i]) (Subscript[w, j]) (Subscript[g, 22])[(Subscript[t, i]),(Subscript[t, j])]+(Subscript[u, i]) (Subscript[u, j]) (Subscript[w, j]^2) (Subscript[g, 23])[(Subscript[t, i]),(Subscript[t, j])]+(Subscript[u, j]^2) (Subscript[w, i]^2) (Subscript[g, 24])[(Subscript[t, i]),(Subscript[t, j])]+(Subscript[u, j]^2) (Subscript[w, i]) (Subscript[w, j]) (Subscript[g, 25])[(Subscript[t, i]),(Subscript[t, j])]+(Subscript[u, j]^2) (Subscript[w, j]^2) (Subscript[g, 26])[(Subscript[t, i]),(Subscript[t, j])]]

Short[t1=Rp[1,2]Rm[3,4]//m[1,3,1]//m[2,4,2] // Last]

Short[t2=CoefficientRules[Expand[t1], {(Subscript[c, 1]),(Subscript[u, 1]),(Subscript[w, 1]),(Subscript[c, 2]),(Subscript[u, 2]),(Subscript[w, 2])}] /. {(_->c_) :> c} /. {(Subscript[t, 1])->x, (Subscript[t, 2])->y}]

Short[{sol}=Solve[#==0&/@t2, Table[(Subscript[g, i])[x,y],{i,26}]]]

EC1=EC0⋃(sol /. {Rule->RuleDelayed} /. (Subscript[g, i_])[x,y]:>(Subscript[g, i])[x_,y_])

ur[i_]:=𝔼[(Subscript[t, i]^(-1/4)),0,0, (Subscript[t, i]^(-1))((Subscript[c, i]) (Subscript[ur, 1])[(Subscript[t, i])]+ (Subscript[c, i]^2) (Subscript[ur, 2])[(Subscript[t, i])]+ (Subscript[u, i]) (Subscript[w, i]) (Subscript[ur, 3])[(Subscript[t, i])]+ (Subscript[c, i]) (Subscript[u, i]) (Subscript[w, i]) (Subscript[ur, 4])[(Subscript[t, i])]+ (Subscript[u, i]^2) (Subscript[w, i]^2) (Subscript[ur, 5])[(Subscript[t, i])])//Expand];
nr[i_]:=𝔼[(Subscript[t, i]^(1/4)),0,0, (Subscript[t, i])(-(Subscript[c, i]) (Subscript[ur, 1])[(Subscript[t, i])]- (Subscript[c, i]^2) (Subscript[ur, 2])[(Subscript[t, i])]- (Subscript[u, i]) (Subscript[w, i]) (Subscript[ur, 3])[(Subscript[t, i])]- (Subscript[c, i]) (Subscript[u, i]) (Subscript[w, i]) (Subscript[ur, 4])[(Subscript[t, i])]- (Subscript[u, i]^2) (Subscript[w, i]^2) (Subscript[ur, 5])[(Subscript[t, i])])//Expand];
ul[i_]:=𝔼[(Subscript[t, i]^(1/4)),0,0, (Subscript[t, i])((Subscript[c, i]) (Subscript[ul, 1])[(Subscript[t, i])]+ (Subscript[c, i]^2) (Subscript[ul, 2])[(Subscript[t, i])]+ (Subscript[u, i]) (Subscript[w, i]) (Subscript[ul, 3])[(Subscript[t, i])]+ (Subscript[c, i]) (Subscript[u, i]) (Subscript[w, i]) (Subscript[ul, 4])[(Subscript[t, i])]+ (Subscript[u, i]^2) (Subscript[w, i]^2) (Subscript[ul, 5])[(Subscript[t, i])])//Expand];
nl[i_]:=𝔼[(Subscript[t, i]^(-1/4)),0,0, (Subscript[t, i]^(-1))(-(Subscript[c, i]) (Subscript[ul, 1])[(Subscript[t, i])]- (Subscript[c, i]^2) (Subscript[ul, 2])[(Subscript[t, i])]- (Subscript[u, i]) (Subscript[w, i]) (Subscript[ul, 3])[(Subscript[t, i])]- (Subscript[c, i]) (Subscript[u, i]) (Subscript[w, i]) (Subscript[ul, 4])[(Subscript[t, i])]- (Subscript[u, i]^2) (Subscript[w, i]^2) (Subscript[ul, 5])[(Subscript[t, i])])//Expand];

ur[1]

The Serpents

From Turaev's "Operator Invariants...":

ur[1]nr[2]//m[1,2,1]

ul[1]nl[2]//m[1,2,1]

Centrality of (some) Kinks

(* kpr for "kink positive right", etc. *)
kpr[i_]:=Module[{s1,s2,s3}, Rp[i,s3]nr[s1]ul[s2] // m[i,s1,i]//m[i,s2,i]//m[i,s3,i]];
kpl[i_]:=Module[{s1,s2,s3}, Rp[s3,i]nl[s1]ur[s2] // m[i,s1,i]//m[i,s2,i]//m[i,s3,i]];
kmr[i_]:=Module[{s1,s2,s3}, Rm[s3,i]nr[s1]ul[s2] // m[i,s1,i]//m[i,s2,i]//m[i,s3,i]];
kml[i_]:=Module[{s1,s2,s3}, Rm[i,s3]nl[s1]ur[s2] // m[i,s1,i]//m[i,s2,i]//m[i,s3,i]];

Most/@{kpr[1], kpl[1], kmr[1], kml[1]}

Most /@ {kpr[1]kmr[2]//m[1,2,1], kpl[1]kml[2]//m[1,2,1]}

E1a=((Rp[x,y]kpr[3]//m[x,3,x])≡(Rp[x,y]kpr[3]//m[3,x,x])) /. (a_==b_):>a-b//. EC1

Short[E1b=CoefficientRules[Expand[E1a], {(Subscript[c, x]),(Subscript[u, x]),(Subscript[w, x]),(Subscript[c, y]),(Subscript[u, y]),(Subscript[w, y])}] /. {(_->c_) :> c} /. {(Subscript[t, x])->x, (Subscript[t, y])->y}]

Short[E1c=DeleteCases[Simplify[E1b], 0] // SortBy[LeafCount], 9]

Solve[(#==0)& /@ E1c, {(Subscript[ul, 1])[x],(Subscript[ul, 2])[x], (Subscript[ul, 4])[x]}]

EC2=EC1⋃{(Subscript[ul, 1])[x_]:>-(Subscript[h, 1])[]-(Subscript[ul, 3])[x]+x (Subscript[ul, 3])[x]+(Subscript[ul, 5])[x]-2 x (Subscript[ul, 5])[x]+(x^2) (Subscript[ul, 5])[x]+(Subscript[ur, 1])[x]+(Subscript[ur, 3])[x]-x (Subscript[ur, 3])[x]-(Subscript[ur, 5])[x]+2 x (Subscript[ur, 5])[x]-(x^2) (Subscript[ur, 5])[x],(Subscript[ul, 2])[x_]:>(Subscript[ul, 5])[x]-2 x (Subscript[ul, 5])[x]+(x^2) (Subscript[ul, 5])[x]+(Subscript[ur, 2])[x]-(Subscript[ur, 5])[x]+2 x (Subscript[ur, 5])[x]-(x^2) (Subscript[ur, 5])[x],(Subscript[ul, 4])[x_]:>-2 (Subscript[ul, 5])[x]+2 x (Subscript[ul, 5])[x]+(Subscript[ur, 4])[x]+2 (Subscript[ur, 5])[x]-2 x (Subscript[ur, 5])[x]}

t1=((Rp[x,y]kpr[3]//m[y,3,y])≡(Rp[x,y]kpr[3]//m[3,y,y])) /. (a_==b_):>a-b//. EC2

Simplify[t1]

Simplify[{
(Rp[x,y]kpr[3]//m[x,3,x])≡(Rp[x,y]kpr[3]//m[3,x,x]),
 (Rp[x,y]kpr[3]//m[y,3,y])≡(Rp[x,y]kpr[3]//m[3,y,y])
}/. (a_==b_):>a-b//. EC2]

Simplify[{
(Rp[x,y]kpl[3]//m[x,3,x])≡(Rp[x,y]kpl[3]//m[3,x,x]),
 (Rp[x,y]kpl[3]//m[y,3,y])≡(Rp[x,y]kpl[3]//m[3,y,y])
}/. (a_==b_):>a-b//. EC2]

Simplify[{
(Rp[x,y]kml[3]//m[x,3,x])≡(Rp[x,y]kml[3]//m[3,x,x]),
 (Rp[x,y]kml[3]//m[y,3,y])≡(Rp[x,y]kml[3]//m[3,y,y])
}/. (a_==b_):>a-b//. EC2]

Simplify[{
(Rp[x,y]kmr[3]//m[x,3,x])≡(Rp[x,y]kmr[3]//m[3,x,x]),
 (Rp[x,y]kmr[3]//m[y,3,y])≡(Rp[x,y]kmr[3]//m[3,y,y])
}/. (a_==b_):>a-b//. EC2]

The Framing Relations

E2a=Last@Simplify[(kpr[1]kmr[2]//m[1,2,1])//.EC2]

Short[E2b=CoefficientRules[Expand[E2a], {(Subscript[c, 1]),(Subscript[u, 1]),(Subscript[w, 1])}] /. {(_->c_) :> c} /. {(Subscript[t, 1])->x}, 9]

Short[E2c=DeleteCases[Simplify[E2b], 0] // SortBy[LeafCount], 9]

Short[E2d=DeleteCases[Simplify[E2c /. {(Subscript[ur, 5])[x_]:>(Subscript[ul, 5])[x], (Subscript[g, 5])[x_]:>((-1+4 (Subscript[g, 6])[x]-16 x (Subscript[g, 6])[x]+24 (x^2) (Subscript[g, 6])[x]-16 (x^3) (Subscript[g, 6])[x]+4 (x^4) (Subscript[g, 6])[x]+2 (Subscript[g, 7])[x]-2 x (Subscript[g, 7])[x]+(Subscript[g, 8])[x]-x (Subscript[g, 8])[x]-x (Subscript[h, 1])[])/(-1+x)),
(Subscript[g, 2])[x_]:>(1/(2 (((-1+x))^2)))(-2-8 (Subscript[g, 6])[x]+32 x (Subscript[g, 6])[x]-48 (x^2) (Subscript[g, 6])[x]+32 (x^3) (Subscript[g, 6])[x]-8 (x^4) (Subscript[g, 6])[x]-(Subscript[h, 1])[]-x (Subscript[h, 1])[]-4 x (Subscript[ul, 3])[x]+4 (x^2) (Subscript[ul, 3])[x]+4 x (Subscript[ur, 3])[x]-4 (x^2) (Subscript[ur, 3])[x])}], 0] // SortBy[LeafCount], 9]

EC3=EC2⋃{(Subscript[ur, 5])[x_]:>(Subscript[ul, 5])[x], (Subscript[g, 5])[x_]:>((-1+4 (Subscript[g, 6])[x]-16 x (Subscript[g, 6])[x]+24 (x^2) (Subscript[g, 6])[x]-16 (x^3) (Subscript[g, 6])[x]+4 (x^4) (Subscript[g, 6])[x]+2 (Subscript[g, 7])[x]-2 x (Subscript[g, 7])[x]+(Subscript[g, 8])[x]-x (Subscript[g, 8])[x]-x (Subscript[h, 1])[])/(-1+x)),
(Subscript[g, 2])[x_]:>(1/(2 (((-1+x))^2)))(-2-8 (Subscript[g, 6])[x]+32 x (Subscript[g, 6])[x]-48 (x^2) (Subscript[g, 6])[x]+32 (x^3) (Subscript[g, 6])[x]-8 (x^4) (Subscript[g, 6])[x]-(Subscript[h, 1])[]-x (Subscript[h, 1])[]-4 x (Subscript[ul, 3])[x]+4 (x^2) (Subscript[ul, 3])[x]+4 x (Subscript[ur, 3])[x]-4 (x^2) (Subscript[ur, 3])[x])}

Simplify[(kpr[1]kmr[2]//m[1,2,1])//.EC3]

Simplify[(kpr[1]kmr[2]//m[2,1,1])//.EC3]

Simplify[(kpl[1]kml[2]//m[1,2,1])//.EC3]

Simplify[(kpl[1]kml[2]//m[2,1,1])//.EC3]

Simplify[kpr[1]≡kpl[1] //. EC3]

Simplify[kmr[1]≡kml[1] //. EC3]

The Swirl Equation

Simplify[(ur[x]Rm[2,5]nr[3]ur[y]nr[6]//m[x,2,x]//m[x,3,x]//m[y,5,y]//m[y,6,y])≡(ul[x]Rm[2,5]nl[3]ul[y]nl[6]//m[x,2,x]//m[x,3,x]//m[y,5,y]//m[y,6,y])//.EC3]

The Cyclic R2 Equation

E3a=Simplify[Last[Rp[6,x]Rm[3,2]ul[y]nl[4]ur[5]nr[7]//m[x,2,x]//m[y,3,y]//m[y,4,y]//m[y,5,y]//m[y,6,y]//m[y,7,y]] //. EC3]

Finding The “Best” Solution

BestEC=EC3⋃{(Subscript[f, 6])[__]->0, (Subscript[f, 9])[__]->0, (Subscript[f, 26])[__]->0, (Subscript[f, 23])[x_,y_]:>(Subscript[g, 4])[y]+(x-1)(Subscript[h, 1])[x,y], (Subscript[h, 1])[]->-1, (Subscript[f, 20])[x_,y_]:>x-((x^2)/2)-((-8 (((-1+x))^3) (Subscript[g, 6])[x]+2 (Subscript[g, 7])[x]+(Subscript[g, 8])[x]+(Subscript[g, 8])[y])/2),(Subscript[g, 7])[_]:>0,(Subscript[ul, 3])[x_]:>((-x)/4)+(Subscript[ur, 3])[x], (Subscript[g, 4|6|8|9])[_]:>0,(Subscript[h, 1])[_,_]:>0,(Subscript[ul, 5])[_]:>0,(Subscript[ur, 2|4])[_]:>0,(Subscript[ur, 3])[x_]:>(x/8), (Subscript[ur, 1])[x_]:>((x^2)/4)};

FromCoefficientRules[
CoefficientRules[Simplify[Rp[1,2] //.BestEC /. {(Subscript[t, 1])->x, (Subscript[t, 2])->y}] // Last, {(Subscript[c, 1]),(Subscript[u, 1]),(Subscript[w, 1]),(Subscript[c, 2]),(Subscript[u, 2]),(Subscript[w, 2])}]/. {(e_->c_) :> (e->Simplify[c])},
{(Subscript[c, 1]),(Subscript[u, 1]),(Subscript[w, 1]),(Subscript[c, 2]),(Subscript[u, 2]),(Subscript[w, 2])}
]

FromCoefficientRules[
CoefficientRules[Simplify[ur[1] //.BestEC/. {(Subscript[t, 1])->x, (Subscript[t, 2])->y}] // Last, {(Subscript[c, 1]),(Subscript[u, 1]),(Subscript[w, 1]),(Subscript[c, 2]),(Subscript[u, 2]),(Subscript[w, 2])}]/. {(e_->c_) :> (e->FullSimplify[c])},
{(Subscript[c, 1]),(Subscript[u, 1]),(Subscript[w, 1]),(Subscript[c, 2]),(Subscript[u, 2]),(Subscript[w, 2])}
]

FromCoefficientRules[
CoefficientRules[Simplify[ul[1] //.BestEC/. {(Subscript[t, 1])->x, (Subscript[t, 2])->y}] // Last, {(Subscript[c, 1]),(Subscript[u, 1]),(Subscript[w, 1]),(Subscript[c, 2]),(Subscript[u, 2]),(Subscript[w, 2])}]/. {(e_->c_) :> (e->FullSimplify[c])},
{(Subscript[c, 1]),(Subscript[u, 1]),(Subscript[w, 1]),(Subscript[c, 2]),(Subscript[u, 2]),(Subscript[w, 2])}
]

FromCoefficientRules[
CoefficientRules[Simplify[Rm[1,2] //.BestEC/. {(Subscript[t, 1])->x, (Subscript[t, 2])->y}] // Last, {(Subscript[c, 1]),(Subscript[u, 1]),(Subscript[w, 1]),(Subscript[c, 2]),(Subscript[u, 2]),(Subscript[w, 2])}]/. {(e_->c_) :> (e->Simplify[c])},
{(Subscript[c, 1]),(Subscript[u, 1]),(Subscript[w, 1]),(Subscript[c, 2]),(Subscript[u, 2]),(Subscript[w, 2])}
]

BestEC

The “Best” Solution

ReplacePart[Rp[i,j],4->FromCoefficientRules[
CoefficientRules[Simplify[Rp[i,j] //.BestEC] // Last, {(Subscript[c, i]),(Subscript[u, i]),(Subscript[w, i]),(Subscript[c, j]),(Subscript[u, j]),(Subscript[w, j])}]/. {(e_->c_) :> (e->Simplify[c])},
{(Subscript[c, i]),(Subscript[u, i]),(Subscript[w, i]),(Subscript[c, j]),(Subscript[u, j]),(Subscript[w, j])}]]

ReplacePart[Rm[i,j],4->FromCoefficientRules[
CoefficientRules[Simplify[Rm[i,j] //.BestEC] // Last, {(Subscript[c, i]),(Subscript[u, i]),(Subscript[w, i]),(Subscript[c, j]),(Subscript[u, j]),(Subscript[w, j])}]/. {(e_->c_) :> (e->Simplify[c])},
{(Subscript[c, i]),(Subscript[u, i]),(Subscript[w, i]),(Subscript[c, j]),(Subscript[u, j]),(Subscript[w, j])}]]

ReplacePart[ur[i],4->FromCoefficientRules[
CoefficientRules[Simplify[ur[i] //.BestEC] // Last, {(Subscript[c, i]),(Subscript[u, i]),(Subscript[w, i])}]/. {(e_->c_) :> (e->Simplify[c])},
{(Subscript[c, i]),(Subscript[u, i]),(Subscript[w, i])}]]

ReplacePart[nr[i],4->FromCoefficientRules[
CoefficientRules[Simplify[nr[i] //.BestEC] // Last, {(Subscript[c, i]),(Subscript[u, i]),(Subscript[w, i])}]/. {(e_->c_) :> (e->Simplify[c])},
{(Subscript[c, i]),(Subscript[u, i]),(Subscript[w, i])}]]

ReplacePart[ul[i],4->FromCoefficientRules[
CoefficientRules[Simplify[ul[i] //.BestEC] // Last, {(Subscript[c, i]),(Subscript[u, i]),(Subscript[w, i])}]/. {(e_->c_) :> (e->Simplify[c])},
{(Subscript[c, i]),(Subscript[u, i]),(Subscript[w, i])}]]

ReplacePart[nl[i],4->FromCoefficientRules[
CoefficientRules[Simplify[nl[i] //.BestEC] // Last, {(Subscript[c, i]),(Subscript[u, i]),(Subscript[w, i])}]/. {(e_->c_) :> (e->Simplify[c])},
{(Subscript[c, i]),(Subscript[u, i]),(Subscript[w, i])}]]

ReplacePart[kpr[i],4->FromCoefficientRules[
CoefficientRules[Simplify[kpr[i] //.BestEC] // Last, {(Subscript[c, i]),(Subscript[u, i]),(Subscript[w, i])}]/. {(e_->c_) :> (e->Simplify[c])},
{(Subscript[c, i]),(Subscript[u, i]),(Subscript[w, i])}]]

ReplacePart[kmr[i],4->FromCoefficientRules[
CoefficientRules[Simplify[kmr[i] //.BestEC] // Last, {(Subscript[c, i]),(Subscript[u, i]),(Subscript[w, i])}]/. {(e_->c_) :> (e->Simplify[c])},
{(Subscript[c, i]),(Subscript[u, i]),(Subscript[w, i])}]]