SetDirectory["C:\\Users\\T15Roland\\Wiskunde\\Bn\\HigherRank"];
Once[<<KnotTheory`];
 <<Rot.m
(SuperPlus[((SuperPlus[α_]))]):=(α^("++"));    
(* this is for cosmetic reasons only *)

(Subscript[r, 0])[1,i_,j_]:=(Subscript[p, 3,j]) (Subscript[x, 1,i]) (Subscript[x, 2,i])-(((Subscript[p, 3,j]) (Subscript[x, 1,j]) (Subscript[x, 2,i]))/(Subscript[T, 1]))(*from r0p*)
(Subscript[r, 0])[-1,i_,j_]:=-(((Subscript[p, 3,j]) (Subscript[x, 1,i]) (Subscript[x, 2,i]))/((Subscript[T, 1]^2) (Subscript[T, 2])))+(((Subscript[p, 3,j]) (Subscript[x, 1,j]) (Subscript[x, 2,i]))/((Subscript[T, 1]) (Subscript[T, 2])))
(Subscript[r, 1])[1,i_,j_]:=(((Subscript[T, 2]) (Subscript[p, 1,j]) (Subscript[p, 2,j]) (Subscript[x, 1,i]) (Subscript[x, 2,i]))/(-1+(Subscript[T, 1]) (Subscript[T, 2])))-(((Subscript[p, 1,j]) (Subscript[p, 2,i]) (Subscript[x, 1,j]) (Subscript[x, 2,i]))/((-1+(Subscript[T, 1])) (Subscript[T, 1]) (-1+(Subscript[T, 1]) (Subscript[T, 2]))))-(((Subscript[p, 1,j]) (Subscript[p, 2,j]) (Subscript[x, 1,j]) (Subscript[x, 2,i]))/((-1+(Subscript[T, 1])) (Subscript[T, 1])))+(((Subscript[p, 1,i]) (Subscript[p, 2,j]) (Subscript[x, 1,i]) (Subscript[x, 2,j]))/((-1+(Subscript[T, 1])) (-1+(Subscript[T, 1]) (Subscript[T, 2]))))+(Subscript[p, 1,j]) (Subscript[p, 2,i]) (Subscript[x, 3,i])-(Subscript[p, 1,j]) (Subscript[p, 2,j]) (Subscript[x, 3,i])+(((Subscript[p, 3,j]) (Subscript[x, 3,i]))/((Subscript[T, 1]) (-1+(Subscript[T, 1]) (Subscript[T, 2]))))-(Subscript[p, 1,j]) (Subscript[p, 3,j]) (Subscript[x, 1,i]) (Subscript[x, 3,i])+(((Subscript[p, 1,j]) (Subscript[p, 3,i]) (Subscript[x, 1,j]) (Subscript[x, 3,i]))/((-1+(Subscript[T, 1])) (Subscript[T, 1]) (-1+(Subscript[T, 1]) (Subscript[T, 2]))))+(((Subscript[p, 1,j]) (Subscript[p, 3,j]) (Subscript[x, 1,j]) (Subscript[x, 3,i]))/(-1+(Subscript[T, 1])))-(((Subscript[T, 2]) (Subscript[p, 2,j]) (Subscript[p, 3,j]) (Subscript[x, 2,i]) (Subscript[x, 3,i]))/(Subscript[T, 1]))-(((Subscript[p, 2,j]) (Subscript[p, 3,i]) (Subscript[x, 2,j]) (Subscript[x, 3,i]))/((Subscript[T, 1]) (-1+(Subscript[T, 1]) (Subscript[T, 2]))))-(((Subscript[p, 1,i]) (Subscript[p, 3,j]) (Subscript[x, 1,i]) (Subscript[x, 3,j]))/((-1+(Subscript[T, 1])) (-1+(Subscript[T, 1]) (Subscript[T, 2]))))+(((Subscript[T, 2]) (Subscript[p, 2,j]) (Subscript[p, 3,j]) (Subscript[x, 2,i]) (Subscript[x, 3,j]))/((Subscript[T, 1]) (-1+(Subscript[T, 1]) (Subscript[T, 2]))))

(Subscript[r, 1])[-1,i_,j_]:=
(((Subscript[p, 1,j]) (Subscript[p, 2,i]) (Subscript[x, 1,i]) (Subscript[x, 2,i]))/((Subscript[T, 1]^2) (-1+(Subscript[T, 1]) (Subscript[T, 2]))))-(((-1+(Subscript[T, 2])) (Subscript[p, 1,i]) (Subscript[p, 2,j]) (Subscript[x, 1,i]) (Subscript[x, 2,i]))/((-1+(Subscript[T, 1])) (Subscript[T, 2]) (-1+(Subscript[T, 1]) (Subscript[T, 2]))))+(((-(Subscript[T, 1])-(Subscript[T, 2])+(Subscript[T, 1]) (Subscript[T, 2])) (Subscript[p, 1,j]) (Subscript[p, 2,j]) (Subscript[x, 1,i]) (Subscript[x, 2,i]))/((Subscript[T, 1]^2) (Subscript[T, 2]) (-1+(Subscript[T, 1]) (Subscript[T, 2]))))+(((Subscript[p, 1,j]) (Subscript[p, 2,i]) (Subscript[x, 1,j]) (Subscript[x, 2,i]))/((-1+(Subscript[T, 1])) (Subscript[T, 1]) (-1+(Subscript[T, 1]) (Subscript[T, 2]))))+(((Subscript[p, 1,j]) (Subscript[p, 2,j]) (Subscript[x, 1,j]) (Subscript[x, 2,i]))/((Subscript[T, 1]) (-1+(Subscript[T, 1]) (Subscript[T, 2]))))-(((Subscript[p, 1,i]) (Subscript[p, 2,j]) (Subscript[x, 1,i]) (Subscript[x, 2,j]))/((-1+(Subscript[T, 1])) (-1+(Subscript[T, 1]) (Subscript[T, 2]))))+(((Subscript[p, 1,j]) (Subscript[p, 2,j]) (Subscript[x, 1,i]) (Subscript[x, 2,j]))/((Subscript[T, 1]) (-1+(Subscript[T, 1]) (Subscript[T, 2]))))-(((Subscript[p, 1,j]) (Subscript[p, 2,i]) (Subscript[x, 3,i]))/(Subscript[T, 1]))+(((Subscript[p, 1,j]) (Subscript[p, 2,j]) (Subscript[x, 3,i]))/(Subscript[T, 1]))-(((Subscript[p, 3,j]) (Subscript[x, 3,i]))/((Subscript[T, 1]) (-1+(Subscript[T, 1]) (Subscript[T, 2]))))-(((Subscript[p, 1,j]) (Subscript[p, 3,i]) (Subscript[x, 1,i]) (Subscript[x, 3,i]))/((Subscript[T, 1]^2) (-1+(Subscript[T, 1]) (Subscript[T, 2]))))+(((Subscript[p, 1,i]) (Subscript[p, 3,j]) (Subscript[x, 1,i]) (Subscript[x, 3,i]))/((-1+(Subscript[T, 1])) (Subscript[T, 1]) (Subscript[T, 2])))-(((Subscript[p, 1,j]) (Subscript[p, 3,j]) (Subscript[x, 1,i]) (Subscript[x, 3,i]))/((Subscript[T, 1]^2) (Subscript[T, 2])))-(((Subscript[p, 1,j]) (Subscript[p, 3,i]) (Subscript[x, 1,j]) (Subscript[x, 3,i]))/((-1+(Subscript[T, 1])) (Subscript[T, 1]) (-1+(Subscript[T, 1]) (Subscript[T, 2]))))+(((-1+(Subscript[T, 2])) (Subscript[p, 2,j]) (Subscript[p, 3,i]) (Subscript[x, 2,i]) (Subscript[x, 3,i]))/((Subscript[T, 1]) (Subscript[T, 2]) (-1+(Subscript[T, 1]) (Subscript[T, 2]))))+(((Subscript[p, 2,i]) (Subscript[p, 3,j]) (Subscript[x, 2,i]) (Subscript[x, 3,i]))/((Subscript[T, 1]^2) (Subscript[T, 2])))-(((-1+2 (Subscript[T, 2])) (Subscript[p, 2,j]) (Subscript[p, 3,j]) (Subscript[x, 2,i]) (Subscript[x, 3,i]))/((Subscript[T, 1]^2) (Subscript[T, 2]^2)))+(((Subscript[p, 2,j]) (Subscript[p, 3,i]) (Subscript[x, 2,j]) (Subscript[x, 3,i]))/((Subscript[T, 1]) (-1+(Subscript[T, 1]) (Subscript[T, 2]))))-(((Subscript[p, 2,j]) (Subscript[p, 3,j]) (Subscript[x, 2,j]) (Subscript[x, 3,i]))/((Subscript[T, 1]^2) (Subscript[T, 2])))+(((Subscript[p, 1,i]) (Subscript[p, 3,j]) (Subscript[x, 1,i]) (Subscript[x, 3,j]))/((-1+(Subscript[T, 1])) (-1+(Subscript[T, 1]) (Subscript[T, 2]))))-(((Subscript[p, 1,j]) (Subscript[p, 3,j]) (Subscript[x, 1,i]) (Subscript[x, 3,j]))/((Subscript[T, 1]) (-1+(Subscript[T, 1]) (Subscript[T, 2]))))-(((Subscript[p, 2,j]) (Subscript[p, 3,j]) (Subscript[x, 2,i]) (Subscript[x, 3,j]))/((Subscript[T, 1]) (-1+(Subscript[T, 1]) (Subscript[T, 2]))))

g2px[ℰ_]:=Module[{λ},Expand[ℰ/.(Subscript[g, α_,i_,j_]):>λ (Subscript[p, α,i])(Subscript[x, α,j])]/.(λ^(k_.)):>1/k!]

{(SuperStar[p]),(SuperStar[x]),(SuperStar[π]),(SuperStar[ξ])}={π,ξ,p,x};  (SuperStar[((Subscript[u_, i__]))]):=(Subscript[((SuperStar[u])), i]);

(Subscript[Zip, {}])[ℰ_]:=ℰ;
(Subscript[Zip, {ζ_,ζs___}])[ℰ_] := (Collect[ℰ//(Subscript[Zip, {ζs}]),ζ] /. f_.(ζ^(d_.)):>(D[f,{(SuperStar[ζ]),d}]))/.(SuperStar[ζ])->0

px2g[ℰ_]:=Module[{ps,xs,Q},
ps=Union[Cases[ℰ,(Subscript[p, __]),∞]];
xs=Union[Cases[ℰ,(Subscript[x, __]),∞]];
Q=Sum[(SuperStar[p0]) (SuperStar[x0]) (Subscript[g, p0[[2]],x0[[2]],p0[[3]],x0[[3]]]),{p0,ps},{x0,xs}];
Expand[(Subscript[Zip, ps⋃xs])[ℰ (E^Q)]/.(Subscript[g, α_,β_,i_,j_]):>If[α===β,(Subscript[g, α,i,j]),0]]
]

(Subscript[R, 1])[1,i_,j_]:=Evaluate[px2g[(Subscript[r, 1])[1,i,j]]+(Coefficient[(Subscript[r, 1])[1,i,j]/.t:(Subscript[(x|p), __]):>λ t, (λ^3)]/.(Subscript[x, 3,α_])(Subscript[p, 1,β_])(Subscript[p, 2,γ_]):>(Subscript[y, α,β,γ]))]
(Subscript[R, 1])[-1,i_,j_]:=Evaluate[px2g[(Subscript[r, 1])[-1,i,j]]+(Coefficient[(Subscript[r, 1])[-1,i,j]/.t:(Subscript[(x|p), __]):>λ t, (λ^3)]/.(Subscript[x, 3,α_])(Subscript[p, 1,β_])(Subscript[p, 2,γ_]):>(Subscript[y, α,β,γ]))]
(Subscript[Piv, i_]):=-(1/((Subscript[T, 1]) (-1+(Subscript[T, 1]) (Subscript[T, 2])))) (Subscript[g, 3,i,i])(*-(((-2+(Subscript[T, 1])+(Subscript[T, 2])) (-(Subscript[T, 1])-(Subscript[T, 2])+2 (Subscript[T, 1]) (Subscript[T, 2])) (Subscript[g, 3,i,i]))/((-1+(Subscript[T, 1])) (-1+(Subscript[T, 2])) (-1+(Subscript[T, 1]) (Subscript[T, 2]))))*)

θ[1,i_,j_,α_,β_,γ_]:=Evaluate[(Subscript[r, 0])[1,i,j]/.{(Subscript[p, 3,j_]):>(Subscript[g, 3,j,α]),(Subscript[x, 1,i_]):>(Subscript[g, 1,β,i]),(Subscript[x, 2,i_]):>(Subscript[g, 2,γ,i])}] ;(* The θ graph with light (pxx) vertex  at (1,i,j) and unspecified heavy (xpp) vertex *)
θ[-1,i_,j_,α_,β_,γ_]:=Evaluate[(Subscript[r, 0])[-1,i,j]/.{(Subscript[p, 3,j_]):>(Subscript[g, 3,j,α]),(Subscript[x, 1,i_]):>(Subscript[g, 1,β,i]),(Subscript[x, 2,i_]):>(Subscript[g, 2,γ,i])}] ;(* The θ graph with light (pxx) vertex  at (-1,i,j) and unspecified heavy (xpp) vertex *)
θ[1,5,8,21,22,23]

(Subscript[T, 3])=(Subscript[T, 1])(Subscript[T, 2]);
CF[ℰ_]:=Factor@Together[ℰ];
λ[K_]:=Module[{Cs,φ,n,A,s,i,j,k,Δ,G,gEval,Y,yEval,c,λ1},
{Cs,φ}=Rot[K]; n=Length[Cs];
A=IdentityMatrix[2n+1];
Cases[Cs,{s_,i_,j_}:>(A[[{i,j},{i+1,j+1}]]+=(({{-(T^s), (T^s)-1}, {0, -1}})))];
Δ=(T^((-Total[φ]-Total[Cs[[All,1]]])/2))Det[A];
G=Inverse[A];
gEval[ℰ_]:=CF[ℰ/.
{(Subscript[g, 1,α_,β_]):>(G[[α,β]]/.T->(Subscript[T, 1])), (Subscript[g, 2,α_,β_]):>(G[[α,β]]/.T->(Subscript[T, 2])),(Subscript[g, 3,α_,β_]):>(G[[α,β]]/.T->(Subscript[T, 3]))}];
Y[α_,β_,γ_]:=Y[α,β,γ]=Sum[{s,i,j}=c; (* The expectation value of (Subscript[x, 3,α])(Subscript[p, 1,β])(Subscript[p, 2,γ])*)
θ[s,i,j,α,β,γ],
{c,Cs}];
yEval[ℰ_]:=ℰ/.(Subscript[y, α_,β_,γ_]):>Y[α,β,γ];
λ1=(∑_(k=1)^n)(Subscript[R, 1])@@Cs[[k]] +(∑_(k=1)^(2n))φ[[k]](Subscript[Piv, k]);
{Δ,(1-(Subscript[T, 3]))(Δ/.T->(Subscript[T, 1]))(Δ/.T->(Subscript[T, 2]))(Δ/.T->(Subscript[T, 3]))λ1}//yEval//gEval//Expand
];
θ[K_]:=Module[{L=λ[K]},{L[[1]],(Subscript[T, 1])L[[2]]+(T D[L[[1]],T]/.T->(Subscript[T, 3]))(L[[1]]/.T->(Subscript[T, 1]))(L[[1]]/.T->(Subscript[T, 2]))}//Expand]

CF[ℰ_]:=Factor@Together[ℰ];
(Subscript[Nλ, p1_,p2_])[K_]:=Module[{G1,G2,G3,Δ1,Δ2,Δ3,A1,A2,A3,Cs,φ,n,A,s,i,j,k,Δ,G,gEval,Y,yEval,c,λ1},
{Cs,φ}=Rot[K]; n=Length[Cs];
A=IdentityMatrix[2n+1];
Cases[Cs,{s_,i_,j_}:>(A[[{i,j},{i+1,j+1}]]+=(({{-(T^s), (T^s)-1}, {0, -1}})))];
A1=A/.T->p1;A2=A/.T->p2;A3=A/.T->p1 p2;
Δ1=(p1^((-Total[φ]-Total[Cs[[All,1]]])/2))Det[A1];
Δ2=(p2^((-Total[φ]-Total[Cs[[All,1]]])/2))Det[A2];
Δ3=(((p1 p2))^((-Total[φ]-Total[Cs[[All,1]]])/2))Det[A3];
G1=Inverse[A1];G2=Inverse[A2];G3=Inverse[A3];
gEval[ℰ_]:=CF[ℰ/.
{(Subscript[g, 1,α_,β_]):>G1[[α,β]], (Subscript[g, 2,α_,β_]):>G2[[α,β]],(Subscript[g, 3,α_,β_]):>G3[[α,β]]}];
Y[α_,β_,γ_]:=Y[α,β,γ]=Sum[{s,i,j}=c; (* The expectation value of (Subscript[x, 3,α])(Subscript[p, 1,β])(Subscript[p, 2,γ])*)
θ[s,i,j,α,β,γ],
{c,Cs}]/.{(Subscript[T, 1])->p1,(Subscript[T, 2])->p2};
yEval[ℰ_]:=ℰ/.(Subscript[y, α_,β_,γ_]):>Y[α,β,γ];
λ1=(∑_(k=1)^n)(Subscript[R, 1])@@Cs[[k]] + (∑_(k=1)^(2n))φ[[k]](Subscript[Piv, k])/.{(Subscript[T, 1])->p1,(Subscript[T, 2])->p2};
{Δ1,(1-p1 p2)Δ1 Δ2 Δ3 λ1}//yEval//gEval//Expand
];

(Subscript[Rrho, 1])[s_,i_,j_]:=s((Subscript[g, j,i])((Subscript[g, j+1,j])+(Subscript[g, j,j+1])-(Subscript[g, i,j]))-(Subscript[g, i,i])((Subscript[g, j,j+1])-1)-1/2);
ρ[K_]:=ρ[K]=Module[{Cs,φ,n,A,s,i,j,k,Δ,G,ρ1},
{Cs,φ}=Rot[K]; n=Length[Cs];
A=IdentityMatrix[2n+1];
Cases[Cs,{s_,i_,j_}:>(A[[{i,j},{i+1,j+1}]]+=(({{-(T^s), (T^s)-1}, {0, -1}})))];
Δ=(T^((-Total[φ]-Total[Cs[[All,1]]])/2))Det[A];
G=Inverse[A];
ρ1=(∑_(k=1)^n)(Subscript[Rrho, 1])@@Cs[[k]] - (∑_(k=1)^(2n))φ[[k]]((Subscript[g, k,k])-1/2);
Expand@Together@{Δ,(Δ^2)ρ1/.(Subscript[g, α_,β_]):>G[[α,β]]}

];

ColFun[t_]:=If[t>0,{t,0,0},{0,0,t}]
Renorm[t_]:=If[t==0,0,Sign[t]Log[Abs[t]+10]]
Poly2Pic[P_]:=Module[{e1=Exponent[P,((Subscript[T, 1])^(-1))],e2=Exponent[P,((Subscript[T, 2])^(-1))],Mat},
If[P===0,P,Mat=Map[Renorm,Normal@SparseArray[CoefficientRules[((Subscript[T, 1])^(e1+1))((Subscript[T, 2])^(e2+1))P,{(Subscript[T, 1]),(Subscript[T, 2])}]],{2}];
MatrixPlot[Mat(*,ColorFunction->(RGBColor[If[#==0,0,1],0,0]&)*)]]
]

Relation to (Subscript[ρ, 1]):

CheckRelationTorho1[K_]:=Module[{th=θ[K][[2]],rh=ρ[K][[2]]},
({th/.{(Subscript[T, 1])->1},th/.{(Subscript[T, 2])->1}}+rh)/.(Subscript[T, _])->T//Together]

CheckRelationTorho1/@AllKnots[{3,8}]

Symmetries

CheckT12swapsym[K_]:=Module[{th=θ[K][[2]]},{th-(th/.{(Subscript[T, 1])->(Subscript[T, 2]),(Subscript[T, 2])->(Subscript[T, 1])})}]

CheckT12swapsym/@AllKnots[{3,8}]//Union

CheckT12swapsym[Knot[11,NonAlternating,34]]

CheckMirr[K_]:=Module[{th=θ[K][[2]],thm=θ[Mirror@K][[2]]},{th+thm}]
CheckMirr/@AllKnots[{3,7}]//Union

CheckMirr[Knot[11,NonAlternating,34]]

CheckT1T2palin[K_]:=Module[{th=θ[K][[2]]},{th-(th/.{(Subscript[T, 1])->((Subscript[T, 1])^(-1)),(Subscript[T, 2])->((Subscript[T, 2])^(-1))})}]

CheckT1T2palin/@AllKnots[{3,8}]//Union

CheckT1T2palin[Knot[11,NonAlternating,34]]

CheckT1T2mystsym[K_]:=Module[{th=θ[K][[2]]},{th-(th/.{(Subscript[T, 1])->(Subscript[T, 1]),(Subscript[T, 2])->((Subscript[T, 3])^(-1))})}]
CheckT1T2mystsym/@AllKnots[{3,8}]

CheckT1T2mystsym[Knot[11,NonAlternating,34]]

Moving to better variables, very similar to Garoufalidis-Kashaev:
u=(Subscript[T, 1])+((Subscript[T, 1])^(-1))+(Subscript[T, 2])+((Subscript[T, 2])^(-1))+(Subscript[T, 3])+((Subscript[T, 3])^(-1))-2
v=((Subscript[T, 1])^2)(Subscript[T, 2])+((Subscript[T, 1])^(-2))((Subscript[T, 2])^(-1))+((Subscript[T, 2])^2)(Subscript[T, 1])+((Subscript[T, 2])^(-2))((Subscript[T, 1])^(-1))+(Subscript[T, 1])((Subscript[T, 2])^(-1))-((Subscript[T, 1])^(-1))(Subscript[T, 2])-2

{u-(u/.{s->t,t->s}),v-(v/.{s->t,t->s})}
{u-(u/.{s->(s^(-1)),t->(t^(-1))}),v-(v/.{s->(s^(-1)),t->(t^(-1))})}
{u-(u/.{t->1/(s t)}),v-(v/.{t->1/(s t)})}//Together

pp[x_]:=x+(x^(-1))
u=pp[s]+pp[t]+pp[s t] +1;
v=pp[(s^2)t]+pp[s (t^2)]+pp[s (t^(-1))]+1;
(Subscript[Monomials, k_])[a_,b_]:=Flatten@Table[((a )^m)(b^n),{m,0,k},{n,0,k-m}]

(*This code is not optimal and runs too slowly!*)
ToUV[Q_]:=Module[{P=Q/.{(Subscript[T, 1])->s,(Subscript[T, 2])->t},deg,degs,degt,ShiftP,UVMons,Coefs,sol,eqs,cr},
If[P==0,Return[0]];
deg=Exponent[P/.{t->s},s];
UVMons=Expand[(Subscript[Monomials, deg])[u,v]];
degs=Exponent[P/.s->1/s,s];
degt=Exponent[P/.t->1/t,t];

degs=Max@Append[Table[Exponent[μ/.s->1/s,s],{μ,UVMons}],degs];
degt=Max@Append[Table[Exponent[μ/.t->1/t,t],{μ,UVMons}],degt];
UVMons=(s^degs)(t^degt)UVMons//Expand;
ShiftP = Expand[P (s^degs)(t^degt)];


Coefs=Table[(Subscript[f, i]),{i,1,Length[UVMons]}];
cr=CoefficientRules[(UVMons.Coefs-ShiftP),{s,t}];
eqs=cr/.{(r_->w_):>w==0};
{sol}=
Solve[eqs,Coefs];

(Subscript[Monomials, deg])[U,V].Coefs/.sol
]
ToUV[-(1/(Subscript[T, 1]^2))-(Subscript[T, 1]^2)-(1/(Subscript[T, 2]^2))-(1/((Subscript[T, 1]^2) (Subscript[T, 2]^2)))+(1/((Subscript[T, 1]) (Subscript[T, 2]^2)))+(1/((Subscript[T, 1]^2) (Subscript[T, 2])))+((Subscript[T, 1])/(Subscript[T, 2]))+((Subscript[T, 2])/(Subscript[T, 1]))+(Subscript[T, 1]^2) (Subscript[T, 2])-(Subscript[T, 2]^2)+(Subscript[T, 1]) (Subscript[T, 2]^2)-(Subscript[T, 1]^2) (Subscript[T, 2]^2)]
Renorm[t_]:=If[t==0,0,Sign[t]Log[Abs[t]+10]]
DrawUVPol[P_]:=Module[{Mat},
If[P===0,Return[P],Mat=Map[Renorm,Normal@SparseArray[CoefficientRules[U V P,{U,V}]],{2}]];
MatrixPlot[Mat]
]

Rolfsen table

UVTable={#,ToUV[θ[#][[2]]]}&/@AllKnots[{3,7}];
Column[%//Factor]

UVTable//Column

{#[[1]],DrawUVPol[#[[2]]]}&/@UVTable//MatrixForm

Ribbon Knot table:

RibbonKnots={Knot[6,1],Knot[8,8],Knot[8,9],Knot[8,20],Knot[9,27],Knot[9,41],Knot[9,46],Knot[10,3],Knot[10,22],Knot[10,35],Knot[10,42],Knot[10,58],Knot[10,75],Knot[10,87],Knot[10,99],Knot[10,123],Knot[10,129],Knot[10,137],Knot[10,140],Knot[10,153],Knot[10,155]};

(Alexander[#][T]&/@RibbonKnots)//Factor

RibTab=Cases[UVTable,{Alternatives@@RibbonKnots,_}];
RibTab//Column;

{#[[1]],DrawUVPol[#[[2]]]}&/@RibTab//MatrixForm

Genus bound:
It appears that  (Subscript[deg, V]) <=  g. Or perhaps  2(Subscript[deg, V]) +(Subscript[deg, U]) <= 2g is sharper.
See also in the Conway and KT cases below. Conway has genus 3, KT genus 2.

Specific knots

Conway and Kinoshita-Terasaka

{UVConway=ToUV[θ[Knot[11,NonAlternating,34]][[2]]],UVKT=ToUV[θ[Knot[11,NonAlternating,42]][[2]]]}
DrawUVPol/@%

Mutant ninja turtles

{UVConway=ToUV[θ[Knot[11,NonAlternating,73]][[2]]],UVKT=ToUV[θ[Knot[11,NonAlternating,74]][[2]]]}
DrawUVPol/@%

GST knot.

PD[GST48]=PD[X[1,15,2,14],X[29,2,30,3],X[40,4,41,3],X[4,44,5,43],X[5,26,6,27],X[95,7,96,6],X[7,1,8,96],X[8,14,9,13],X[28,9,29,10],X[41,11,42,10],X[11,43,12,42],X[12,27,13,28],X[15,31,16,30],X[61,16,62,17],X[72,17,73,18],X[83,18,84,19],X[34,20,35,19],X[20,89,21,90],X[92,21,93,22],X[22,79,23,80],X[23,68,24,69],X[24,57,25,58],X[56,25,57,26],X[31,63,32,62],X[32,74,33,73],X[33,85,34,84],X[35,50,36,51],X[81,37,82,36],X[70,38,71,37],X[59,39,60,38],X[54,39,55,40],X[55,45,56,44],X[45,59,46,58],X[46,70,47,69],X[47,81,48,80],X[91,49,92,48],X[49,91,50,90],X[82,52,83,51],X[71,53,72,52],X[60,54,61,53],X[74,63,75,64],X[85,64,86,65],X[65,76,66,77],X[66,87,67,88],X[94,67,95,68],X[86,75,87,76],X[77,88,78,89],X[93,78,94,79]];

KGST48=θ[PD@GST48];

UVGST48=ToUV[KGST48[[2]]]

DrawUVPol[UVGST48]

DunfieldKnotList=ReadList["C:\\Users\\T15Roland\\Wiskunde\\Bn\\HigherRank\\nmd_random_knots.txt"]/.{i_Integer:>i+1};

ToUV[θ[DunfieldKnotList[[10]]][[2]]]
DrawUVPol@%

ToUV[θ[DunfieldKnotList[[30]]][[2]]]
DrawUVPol@%

(*My ToUV is too slow to handle this*)

DK120=<<Theta4DK120.m;

Invariance Proof

(Subscript[δ, i_,j_]):=If[i===j,1,0];

(Subscript[gRules, s_,i_,j_]):={
(Subscript[g, ν_,i,β_]):>(Subscript[δ, i,β])+(Subscript[T, ν]^s)(Subscript[g, ν,(SuperPlus[i]),β])+(1-(Subscript[T, ν]^s))(Subscript[g, ν,(SuperPlus[j]),β]),(Subscript[g, ν_,j,β_]):>(Subscript[δ, j,β])+(Subscript[g, ν,(SuperPlus[j]),β]),
(Subscript[g, ν_,α_,i]):>(Subscript[T, ν]^(-s))((Subscript[g, ν,α,(SuperPlus[i])])-(Subscript[δ, α,(SuperPlus[i])])),(Subscript[g, ν_,α_,j]):>(Subscript[g, ν,α,(SuperPlus[j])])-(1-(Subscript[T, ν]^s))(Subscript[g, ν,α,i])-(Subscript[δ, α,(SuperPlus[j])])
};
gRules[Cs_List]:=Union@@(((Subscript[gRules, Sequence@@#]))&/@Cs)

Invariance of (Subscript[y, αβγ]) under remote R2bs

Clear[i,j];
Cs={{1,i,j},{-1,(SuperPlus[i]),(SuperPlus[j])}}
Z=Module[{s,i,j},Sum[{s,i,j}=c;θ[s,i,j,α,β,γ],{c,Cs}]]

Expand[Z//.(Subscript[gRules, 1,i,j])⋃(Subscript[gRules, -1,(SuperPlus[i]),(SuperPlus[j])])/._If->0]

Invariance of (Subscript[y, αβγ]) under remote R3s

Clear[i,j,k];
Cs={{1,i,j},{1,(SuperPlus[i]),k},{1,(SuperPlus[j]),(SuperPlus[k])}}
Z=Module[{s,i,j},Sum[{s,i,j}=c;
{s,i,j}=c;θ[s,i,j,α,β,γ],
{c,Cs}]]
lhs=Simplify[Z//.gRules[Cs]/._If->0]

Clear[i,j,k];
Cs={{1,j,k},{1,i,(SuperPlus[k])},{1,(SuperPlus[i]),(SuperPlus[j])}}
Z=Module[{s,i,j},Sum[{s,i,j}=c;
{s,i,j}=c;θ[s,i,j,α,β,γ],
{c,Cs}]]
rhs=Simplify[Z//.gRules[Cs]/._If->0]

lhs==rhs

Invariance of (Subscript[y, αβγ]) under remote R2cs

Clear[i,j];
Cs={{1,(SuperPlus[i]),j},{-1,i,(SuperPlus[j])}};
Z=Module[{s,i,j},Sum[{s,i,j}=c;θ[s,i,j,α,β,γ],{c,Cs}]]
Expand[Z//.(Subscript[gRules, 1,(SuperPlus[i]),j])⋃(Subscript[gRules, -1,i,(SuperPlus[j])])/._If->0]

Invariance under R2b

Y[α_,β_,γ_]:=Module[{s,i,j},Sum[{s,i,j}=c;θ[s,i,j,α,β,γ],{c,Cs}]];
yEval[ℰ_]:=ℰ/.(Subscript[y, α_,β_,γ_]):>Y[α,β,γ];

Clear[i,j];
Cs={{1,i,j},{-1,(SuperPlus[i]),(SuperPlus[j])}}
Expand@Together[(Total[(Subscript[R, 1])@@@Cs]//yEval)//.gRules[Cs]]

Invariance under R3b

Clear[i,j,k];
Cs={{1,i,j},{1,(SuperPlus[i]),k},{1,(SuperPlus[j]),(SuperPlus[k])}}
lhs=Expand@Together[(Total[(Subscript[R, 1])@@@Cs]//yEval)//.gRules[Cs]]

Clear[i,j,k];
Cs={{1,j,k},{1,i,(SuperPlus[k])},{1,(SuperPlus[i]),(SuperPlus[j])}}
rhs=Expand@Together[(Total[(Subscript[R, 1])@@@Cs]//yEval)//.gRules[Cs]]

lhs==rhs

Invariance under R2c

Clear[i,j];
Cs={{1,(SuperPlus[i]),j},{-1,i,(SuperPlus[j])}};
lhs=Expand@Together[(Total[(Subscript[R, 1])@@@Cs]+(Subscript[Piv, (SuperPlus[j])])//yEval)//.gRules[Cs]]
rhs=(Subscript[Piv, (j^("++"))]);
lhs==rhs//FullSimplify

Solve[1+h (Subscript[T, 1]) (-1+(Subscript[T, 1]) (Subscript[T, 2]))==0,h]

Invariance under R1l

Cs={{1,(SuperPlus[i]),i}};
gRules[Cs]

gr1lRules={(Subscript[g, ν$_,i,β$_]):>(Subscript[δ, i,β$])+(Subscript[g, ν$,(SuperPlus[i]),β$]),
(Subscript[g, ν$_,α$_,i]):>(Subscript[g, ν$,α$,(SuperPlus[i])])-(1-(Subscript[T, ν$]^1)) (Subscript[g, ν$,α$,(SuperPlus[i])])-(Subscript[δ, α$,(SuperPlus[i])]),
(Subscript[g, ν$_,α$_,(SuperPlus[i])]):>(Subscript[T, ν$]^(-1)) ((Subscript[g, ν$,α$,(SuperPlus[((SuperPlus[i]))])])-(Subscript[δ, α$,(SuperPlus[((SuperPlus[i]))])])),
(Subscript[g, ν$_,(SuperPlus[i]),β$_]):>(Subscript[T, ν$]^(-1))((Subscript[δ, (SuperPlus[i]),β$])+(Subscript[T, ν$]^1) (Subscript[g, ν$,(SuperPlus[((SuperPlus[i]))]),β$]))}

Total[(Subscript[R, 1])@@@Cs]

(Total[(Subscript[R, 1])@@@Cs]+(Subscript[Piv, (SuperPlus[i])])//yEval)//.gr1lRules//Simplify

Invariance under R1r

Cs={{1,i,(SuperPlus[i])}};
gRules[Cs]

gr1rRules={
(Subscript[g, ν$_,i,β$_]):>(Subscript[δ, i,β$])+(Subscript[T, ν$]^1) (Subscript[g, ν$,(SuperPlus[i]),β$])+(1-(Subscript[T, ν$]^1)) (Subscript[g, ν$,(SuperPlus[((SuperPlus[i]))]),β$]),
(Subscript[g, ν$_,α$_,i]):>(Subscript[T, ν$]^(-1)) ((Subscript[g, ν$,α$,(SuperPlus[i])])-(Subscript[δ, α$,(SuperPlus[i])])),
 (Subscript[g, ν$_,α$_,i]):>(((1-(Subscript[T, ν$]^1)))^(-1))(-(Subscript[g, ν$,α$,(SuperPlus[i])])+(Subscript[g, ν$,α$,(SuperPlus[((SuperPlus[i]))])])-(Subscript[δ, α$,(SuperPlus[((SuperPlus[i]))])])),
(Subscript[g, ν$_,(SuperPlus[i]),β$_]):>(Subscript[δ, (SuperPlus[i]),β$])+(Subscript[g, ν$,(SuperPlus[((SuperPlus[i]))]),β$])};

Total[(Subscript[R, 1])@@@Cs]

(Total[(Subscript[R, 1])@@@Cs]-(Subscript[Piv, (SuperPlus[i])])//yEval)//.gr1rRules//Simplify

Invariance under Swirl

Cs={{1,i,j}};
gRules[Cs]

rhs=(Total[(Subscript[R, 1])@@@Cs]+(Subscript[Piv, i])+(Subscript[Piv, j])-(Subscript[Piv, (SuperPlus[i])])-(Subscript[Piv, (SuperPlus[j])])//yEval)//.gRules[Cs]//Simplify
lhs=(Total[(Subscript[R, 1])@@@Cs]//yEval)//.gRules[Cs];
lhs-rhs//Simplify;