Pensieve header: Perturbed Alexander-Burau Invariants. DPG code from PerturbedHeisenberg2.nb at pensieve://Classes/21-1350-KnotTheory/. Continued pensieve://Projects/APerturbedAlexanderInvariant/.

Once[<<KnotTheory`];

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]];

ThinPosition[K_]:=Module[{todo,done,pd,c},
todo=List@@PD@K; done={}; pd=PD[];
While[todo=!={},
AppendTo[pd,c=RandomChoice@MaximalBy[todo, Length[done⋂List@@#]&]];
todo=DeleteCases[todo, c];
done=done⋃List@@c];
pd ]

RVK::usage="RVK[xs, rots] represents a Rotational Virtual Knot with a list of n Xp/Xm crossings xs and a length 2n list of rotation numbers rots. Crossing sites are indexed 1 through 2n, and rots[[k]] is the rotation between site k-1 and site k. RVK is also a casting operator converting to the RVK presentation from other knot presentations.";

RVK[pd_PD]:=Module[{n,xs,x,rots,front={1},k},
n=Length@pd;rots=Table[0,{2n}];
xs=Cases[pd,x_X:>(Piecewise[{{Xp[x[[4]],x[[1]]], PositiveQ@x}, {Xm[x[[2]],x[[1]]], True}}])];
For[k=1,k<=2n,++k,
If[FreeQ[front,-k],
front=Flatten@Replace[front,k->(xs/.{
Xp[k,l_]|Xm[l_,k]:>{l+1,k+1,-l},
Xp[l_,k]|Xm[k,l_]:>(++rots[[l]];{-l,k+1,l+1}),
_Xp|_Xm:>{}
}), {1}],
Cases[front,k|-k]/.{k,-k}:>--rots[[k]];
]
];
RVK[xs,rots] ];
RVK[K_]:=RVK[PD[K]];

(Subscript[rot, i_])[n_]:=(*(Subscript[rot, i])[n]=*)(Piecewise[{{(Subscript[η, i]), n==0}, {(Subscript[C, $])(Subscript[rot, i])[n-1]// (Subscript[m, i,$->i]), n>0}, {(Subscript[(OverBar[C]), $])(Subscript[rot, i])[n+1]// (Subscript[m, i,$->i]), n<0}}])

Z[K_] := Z[RVK@K];
Z[rvk_RVK] :=Module[{ζ,done,st,c, χ,i,j,k},
ζ=1; done={}; st=Range[2Length[rvk[[1]]]];
Do[
{i,j}=List@@c;
χ=c/.{_Xp:>(Subscript[R, i,j]),_Xm:>(Subscript[(OverBar[R]), i,j])};
Do[χ=((Subscript[rot, 0])[rvk[[2,k]]]χ)//(Subscript[m, 0,k->k]), {k,{i,j}}];
ζ*=χ;
Do[
If[MemberQ[done, k+1],ζ=ζ//(Subscript[m, k,k+1->k]); st=st/.k+1->k];
If[MemberQ[done, k-1],ζ=ζ//(Subscript[m, st[[k-1]],k->st[[k-1]]]); st=st/.k->st[[k-1]]],
{k,{i,j}}];
done=done⋃{i,j},
{c,rvk[[1]]}
];
Factor@ζ
]

ZF[K_]:=Z@ThinPosition@K;

$k=1;

CCF[ℰ_] := ExpandDenominator@ExpandNumerator@Together[ℰ];

CF[ℰ_List]:=CF/@ℰ;
CF[ℰ_ϵSeries]:=CF/@ℰ;
CF[ℰ_] :=Module[
{vs=Cases[ℰ,(Subscript[(p|x|π|ξ), _]),∞]⋃{p|x|π|ξ}},
Total[CoefficientRules[Expand[ℰ], vs] /. (ps_->c_) :> CCF[c](Times@@(vs^ps))]
];
CF[ℰ_𝔼]:=CF/@ℰ;
CF[γ_Γ]:=CF/@γ; 
CF[(Subscript[𝔼, sp___])[ℰs___]]:=CF/@(Subscript[𝔼, sp])[ℰs];

ϵSeries/: S1_ϵSeries≡S2_ϵSeries:=Length[S1]==Length[S2]∧Inner[CF[#1]==CF[#2]&,S1,S2,And];
ϵSeries[0]:=ϵSeries@@Table[0,$k+1];
ϵSeries/: S1_ϵSeries+S2_ϵSeries := ϵSeries@@Table[S1[[k]]+S2[[k]],{k,Min[Length@S1,Length@S2]}];
ϵSeries/: S1_ϵSeries*S2_ϵSeries := ϵSeries@@Table[Sum[S1[[j+1]]*S2[[k-j+1]], {j,0,k}],{k,0,Min[Length@S1,Length@S2]-1}];
ϵSeries /:c_*S_ϵSeries:=(c#)& /@ S;
ϵSeries/:(∂_(vs___))S_ϵSeries:=(s|->(∂_vs)s)/@S;

{(SuperStar[p]),(SuperStar[x]),(SuperStar[π]),(SuperStar[ξ])}={π,ξ,p,x}; 
(SuperStar[(vs_List)]):=(v|->(SuperStar[v]))/@vs;
(SuperStar[((Subscript[u_, i_]))]):=(Subscript[((SuperStar[u])), i]);

𝔼/:𝔼[ω1_,Q1_,P1_]≡𝔼[ω2_,Q2_,P2_]:=CF[ω1==ω2]∧CF[Q1==Q2]∧(P1≡P2);
𝔼/:𝔼[ω1_,Q1_,P1_]𝔼[ω2_,Q2_,P2_]:=𝔼[ω1 ω2,Q1+Q2,P1+P2];
(Subscript[𝔼, d1_->r1_])[ℰ1s___]≡(Subscript[𝔼, d2_->r2_])[ℰ2s___] ^:= (d1==d2)∧(r1==r2)∧(𝔼[ℰ1s]≡𝔼[ℰ2s]);
(Subscript[𝔼, d1_->r1_])[ℰ1s___](Subscript[𝔼, d2_->r2_])[ℰ2s___] ^:= (Subscript[𝔼, (d1⋃d2)->(r1⋃r2)])@@(𝔼[ℰ1s]𝔼[ℰ2s]);

(Subscript[Zip1, {}])=Identity;
(Subscript[Zip1, vs_])@⟨ℱ_,𝔼[ω_,Q_,P_]⟩ := Module[{ℐ,F,G,u,v},
ℐ=IdentityMatrix@Length@vs;
F=Table[(∂_(u,v))ℱ,{u,(SuperStar[vs])},{v,(SuperStar[vs])}];
G=Table[(∂_(u,v))Q,{u,vs},{v,vs}];
CF/@⟨
(SuperStar[vs]).F.Inverse[ℐ-G.F].(SuperStar[vs])/2,
𝔼[PowerExpand@Factor[ω  ((Det[ℐ- G.F])^(-1/2))],Q-vs.G.vs/2,P]
⟩
]

(Subscript[Zip2, {}])=Identity;
(Subscript[Zip2, vs_])@⟨ℱ_,𝔼[ω_,Q_,P_]⟩ := Module[{F,Y,u,v},
F=Table[(∂_(u,v))ℱ,{u,(SuperStar[vs])},{v,(SuperStar[vs])}];
Y=Table[(∂_v)Q,{v,vs}];
CF/@⟨ℱ, 𝔼[ω,Q-Y.vs+Y.F.Y/2, P/.Thread[vs->vs+F.Y]]⟩
]

(Subscript[Zip3, vs_])@⟨ℱ_,𝔼[ω_,Q_,P_]⟩ := Module[{Z,u,v,m,j},
Z[0]=P;
For[m=0,m<2$k,++m,
Z[m+1]=CF[(1/(2(m+1)))Sum[(∂_((SuperStar[u]),(SuperStar[v])))ℱ((∂_(u,v))Z[m]+Sum[((∂_u)Z[j])((∂_v)Z[m-j]),{j,0,m}]),{u,vs},{v,vs}]]
];
𝔼[ω,Q,CF[Sum[Z[m],{m,0,2$k}]/.Table[v->0,{v,vs}]]]
]

(Subscript[Zip, vs_])[ℱ_,ℰ_]:=⟨ℱ,ℰ⟩//(Subscript[Zip1, vs])//(Subscript[Zip2, vs])//(Subscript[Zip3, vs])

(Subscript[𝔼, d1_->r1_])[ℰ1s___]//(Subscript[𝔼, d2_->r2_])[ℰ2s___] :=Module[{is=r1⋂d2,lvs},
lvs=Flatten@Table[{(Subscript[x, $@i]),(Subscript[p, $@i])},{i,is}];
(Subscript[𝔼, (d1⋃Complement[d2,is])->(r2⋃Complement[r1,is])])@@((Subscript[Zip, lvs⋃(SuperStar[lvs])])[(SuperStar[lvs]).lvs,Times[
𝔼[ℰ1s]/.Table[(Subscript[(v:x|p), i])->(Subscript[v, $@i]),{i,is}],
𝔼[ℰ2s]/.Table[(Subscript[(v:ξ|π), i])->(Subscript[v, $@i]),{i,is}]
]])
]

(Subscript[η, i_]):=(Subscript[𝔼, {}->{i}])[1,0,ϵSeries[0]];
(Subscript[m, i_,j_->k_]):=(Subscript[𝔼, {i,j}->{k}])[1,-(Subscript[ξ, i])(Subscript[π, j])+((Subscript[π, i])+(Subscript[π, j]))(Subscript[p, k])+((Subscript[ξ, i])+(Subscript[ξ, j]))(Subscript[x, k]),ϵSeries[0]]

AllMonomials[{},0]={1};
AllMonomials[{},d_Integer] /; d>0 := {};
AllMonomials[{v_,vs___},d_Integer] := Join@@Table[(v^(d-k))AllMonomials[{vs},k],{k,0,d}];
AllMonomials[vs_List, {d_}] := Join@@Table[AllMonomials[vs,k],{k,0,d}];

Basis[js_List,m_]:=Flatten@Outer[Times,AllMonomials[Table[(Subscript[p, j]),{j,js}],m],AllMonomials[Table[(Subscript[x, j]),{j,js}],m]];
Basis[js_List,{m_}]:=Flatten@Table[Basis[js,k],{k,0,m}]

GenericCombination[bas_,c_]:=bas.Table[(Subscript[c, j]),{j,Length@bas}];
GenericCombination[bas_,(Subscript[c_, k_])]:=bas.Table[(Subscript[c, k,j]),{j,Length@bas}];

(Subscript[R0, i_,j_]):=(Subscript[𝔼, {}->{i,j}])[(T^(1/2)),(T-1)((Subscript[p, i])-(Subscript[p, j])) (Subscript[x, j]) ,ϵSeries@@Table[0,$k+1]];
(Subscript[Rp, i_,j_]):=(Subscript[𝔼, {}->{i,j}])[1,0,ϵSeries@@Prepend[0]@Table[GenericCombination[Basis[{i,j},{k+1}],(Subscript[c, k])],{k,$k}]];(Subscript[R, i_,j_]):=Module[{i1,j1}, (Subscript[R0, i,j])(Subscript[Rp, i1,j1])//(Subscript[m, i,i1->i])//(Subscript[m, j,j1->j])];

(Subscript[(OverBar[R0]), i_,j_]):=(Subscript[𝔼, {}->{i,j}])[(T^(-1/2)),((T^(-1))-1)((Subscript[p, i])-(Subscript[p, j])) (Subscript[x, j]) ,ϵSeries@@Table[0,$k+1]];
(Subscript[(OverBar[Rp]), i_,j_]):=(Subscript[𝔼, {}->{i,j}])[1,0,ϵSeries@@Prepend[0]@Table[GenericCombination[Basis[{i,j},{k+1}],(Subscript[d, k])],{k,$k}]];(Subscript[(OverBar[R]), i_,j_]):=Module[{i1,j1}, (Subscript[(OverBar[R0]), i,j])(Subscript[(OverBar[Rp]), i1,j1])//(Subscript[m, i,i1->i])//(Subscript[m, j,j1->j])];

(Subscript[C, i_]):=(Subscript[𝔼, {}->{i}])[(T^(1/2)),0,ϵSeries@@Prepend[0]@Table[GenericCombination[Basis[{i},{k+1}],(Subscript[e, k])],{k,$k}]];
(Subscript[(OverBar[C]), i_]):=(Subscript[𝔼, {}->{i}])[(T^(-1/2)),0,ϵSeries@@Prepend[0]@Table[GenericCombination[Basis[{i},{k+1}],(Subscript[f, k])],{k,$k}]];

CF/@{(Subscript[R, 1,2]), (Subscript[(OverBar[R]), 1,2]),(Subscript[C, 1]),(Subscript[(OverBar[C]), 1])}

RMoves:={
((Subscript[R, 1,2])(Subscript[R, 4,3])(Subscript[R, 5,6])//(Subscript[m, 1,4->1])//(Subscript[m, 2,5->2])//(Subscript[m, 3,6->3]))≡((Subscript[R, 2,3])(Subscript[R, 4,5])(Subscript[R, 1,6])//(Subscript[m, 1,4->1])//(Subscript[m, 2,5->2])//(Subscript[m, 3,6->3])),
((Subscript[R, 1,2])(Subscript[(OverBar[R]), 3,4])//(Subscript[m, 1,3->1])//(Subscript[m, 2,4->2]))≡((Subscript[η, 1])(Subscript[η, 2])),
((Subscript[C, 1])(Subscript[(OverBar[C]), 2])//(Subscript[m, 1,2->1]) )≡(Subscript[η, 1]),
((Subscript[R, 1,4])(Subscript[(OverBar[R]), 5,2])(Subscript[(OverBar[C]), 3])//(Subscript[m, 2,4->2])//(Subscript[m, 1,3->1])//(Subscript[m, 1,5->1]))≡(Subscript[(OverBar[C]), 1])(Subscript[η, 2]),
((Subscript[C, 3])(Subscript[R, 1,2])//(Subscript[m, 2,3->2])//(Subscript[m, 2,1->1]))≡((Subscript[(OverBar[C]), 3])(Subscript[R, 1,2])//(Subscript[m, 1,3->1])//(Subscript[m, 1,2->1])),
((Subscript[(OverBar[C]), 2])(Subscript[R, 1,3])//(Subscript[m, 1,2->1])//(Subscript[m, 1,3->1]))≡(Subscript[η, 1]), ((Subscript[(OverBar[C]), 2])(Subscript[(OverBar[R]), 3,1])//(Subscript[m, 1,2->1])//(Subscript[m, 1,3->1]))≡(Subscript[η, 1]),
((Subscript[C, 2])(Subscript[(OverBar[R]), 1,3])//(Subscript[m, 1,2->1])//(Subscript[m, 1,3->1]))≡(Subscript[η, 1]),((Subscript[C, 2])(Subscript[R, 3,1])//(Subscript[m, 1,2->1])//(Subscript[m, 1,3->1]))≡(Subscript[η, 1])
}

Short[RMoves,10]

Solving for R, C, $k=1

$k=1;
{(Subscript[R, 1,2]),(Subscript[C, 1])}
unknowns=Cases[{(Subscript[R, 1,2]),(Subscript[(OverBar[R]), 1,2]),(Subscript[C, 1]),(Subscript[(OverBar[C]), 1])},(Subscript[(c|d|e|f), $k,_]),∞]//Union

Short[errors=CCF/@Cases[RMoves,  a_==b_ :> a-b], 25]

Short[
eqns=Thread[0==Union@@(CoefficientRules[#,{(Subscript[x, 1]),(Subscript[x, 2]),(Subscript[x, 3]),(Subscript[p, 1]),(Subscript[p, 2]),(Subscript[p, 3])}][[;;,2]]& /@ errors)],
10]

{sol}=Solve[eqns,unknowns]

sol/.(a_->b_):>(a=b)

CF/@{(Subscript[Rp, 1,2]),(Subscript[(OverBar[Rp]), 1,2]),(Subscript[C, 1]),(Subscript[(OverBar[C]), 1])}

Factor/@CF[Last@ZF@Knot[6,1]-Last@ZF@Knot[9,46]]

Cases[{(Subscript[Rp, 1,2]),(Subscript[(OverBar[Rp]), 1,2]),(Subscript[C, 1]),(Subscript[(OverBar[C]), 1])},(Subscript[(c|d|e|f), $k,_]),∞]//Union

CF/@({(Subscript[Rp, 1,2]),(Subscript[(OverBar[Rp]), 1,2]),(Subscript[C, 1]),(Subscript[(OverBar[C]), 1])}/. {(Subscript[c, 1,10])->-1/2,(Subscript[c, 1,2])->0,(Subscript[c, 1,5])->0})

CF/@({(Subscript[Rp, 1,2]),(Subscript[(OverBar[Rp]), 1,2]),(Subscript[C, 1]),(Subscript[(OverBar[C]), 1])}/. {(Subscript[c, 1,10])->-1/2,(Subscript[c, 1,2])->0,(Subscript[c, 1,5])->0,(Subscript[c, 1,11])->T/2})

{(Subscript[c, 1,10])=-1/2,(Subscript[c, 1,2])=0,(Subscript[c, 1,5])=0,(Subscript[c, 1,11])=T/2};
CF/@{(Subscript[R, 1,2]),(Subscript[(OverBar[R]), 1,2]),(Subscript[C, 1]),(Subscript[(OverBar[C]), 1])}

CF[(Subscript[R, 1,2])/.T->(T^(-1))]

RMoves

The isomorphism with Γ-calculus

Γ[(Subscript[𝔼, {}->is_])[ω_,Q_,_]]:=CF@Γ[(ω^(-1)),Sum[(Subscript[p, i])(Subscript[x, i]),{i,is}]-Q]
𝔼[Γ[ω_,A_]]:=Module[{is=Union@Cases[A,(Subscript[p, i_]):>i,∞]},
CF@(Subscript[𝔼, {}->is])[(ω^(-1)),Sum[(Subscript[p, i])(Subscript[x, i]),{i,is}]-A,ϵSeries[0]]]

{(Subscript[R, i,j]),(Subscript[R, i,j])//Γ,(Subscript[R, i,j])//Γ//𝔼}//Column

γ1=Γ[ω,{(Subscript[x, i]),(Subscript[x, j]),(Subscript[x, r])}.(({{α, β, θ}, {γ, δ, ϵ}, {ϕ, ψ, Ξ}})).{(Subscript[p, i]),(Subscript[p, j]),(Subscript[p, r])}]//𝔼

γ1//(Subscript[m, i,j->k])//Γ

Simplify[(𝔼@Γ[ω,{(Subscript[x, 1]),(Subscript[x, 2]),(Subscript[x, 3])}.(({{α, β, γ}, {δ, ϵ, η}, {λ, μ, ν}})).{(Subscript[p, 1]),(Subscript[p, 2]),(Subscript[p, 3])}](Subscript[𝔼, {}->{i,j}])[1,0,ϵSeries[0,(Subscript[p, i])(Subscript[x, i])]]//(Subscript[m, 1,i->1])//(Subscript[m, 1,2->1])//(Subscript[m, 1,j->1])//(Subscript[m, 1,3->1]))[[3,2]]/.(Subscript[(x|p), _])->0]

Simplify[(𝔼@Γ[ω,{(Subscript[x, 1]),(Subscript[x, 2]),(Subscript[x, 3])}.(({{α, β, γ}, {δ, ϵ, η}, {λ, μ, ν}})).{(Subscript[p, 1]),(Subscript[p, 2]),(Subscript[p, 3])}](Subscript[𝔼, {}->{i,j}])[1,0,ϵSeries[0,(Subscript[p, i])(Subscript[x, j])]]//(Subscript[m, 1,i->1])//(Subscript[m, 1,2->1])//(Subscript[m, 1,j->1])//(Subscript[m, 1,3->1]))[[3,2]]/.(Subscript[(x|p), _])->0]

Simplify[(𝔼@Γ[ω,{(Subscript[x, 1]),(Subscript[x, 2]),(Subscript[x, 3])}.(({{α, β, γ}, {δ, ϵ, η}, {λ, μ, ν}})).{(Subscript[p, 1]),(Subscript[p, 2]),(Subscript[p, 3])}](Subscript[𝔼, {}->{i,j}])[1,0,ϵSeries[0,(Subscript[p, j])(Subscript[x, i])]]//(Subscript[m, 1,i->1])//(Subscript[m, 1,2->1])//(Subscript[m, 1,j->1])//(Subscript[m, 1,3->1]))[[3,2]]/.(Subscript[(x|p), _])->0]

Simplify[(𝔼@Γ[ω,{(Subscript[x, 1]),(Subscript[x, 2]),(Subscript[x, 3])}.(({{α, β, γ}, {δ, ϵ, η}, {λ, μ, ν}})).{(Subscript[p, 1]),(Subscript[p, 2]),(Subscript[p, 3])}](Subscript[𝔼, {}->{i,j}])[1,0,ϵSeries[0,(Subscript[p, j])(Subscript[x, j])]]//(Subscript[m, 1,i->1])//(Subscript[m, 1,2->1])//(Subscript[m, 1,j->1])//(Subscript[m, 1,3->1]))[[3,2]]/.(Subscript[(x|p), _])->0]

(Subscript[C, i])

CF[(Subscript[(OverBar[Rp]), i,j])/.T->(T^(-1))]

CF[(Subscript[Rp, i,j])]

Simplify[(1/4) (1-T) (Subscript[p, i]^2) (Subscript[x, i]) (Subscript[x, j])-(1/2) (Subscript[p, i]) (Subscript[p, j]) (Subscript[x, i]) (Subscript[x, j])+(1/4) (-T+(T^2)) (Subscript[p, i]^2) (Subscript[x, j]^2)+(1/2) T (Subscript[p, i]) (Subscript[p, j]) (Subscript[x, j]^2)]

Simplify[(𝔼@Γ[ω,{(Subscript[x, 1]),(Subscript[x, 2]),(Subscript[x, 3])}.(({{α, β, γ}, {δ, ϵ, η}, {λ, μ, ν}})).{(Subscript[p, 1]),(Subscript[p, 2]),(Subscript[p, 3])}](Subscript[𝔼, {}->{i,j}])[1,0,ϵSeries[0,(Subscript[p, i]^2) (Subscript[x, i]) (Subscript[x, j])]]//(Subscript[m, 1,i->1])//(Subscript[m, 1,2->1])//(Subscript[m, 1,j->1])//(Subscript[m, 1,3->1]))[[3,2]]/.(Subscript[(x|p), _])->0]

Simplify[(𝔼@Γ[ω,{(Subscript[x, 1]),(Subscript[x, 2]),(Subscript[x, 3])}.(({{α, β, γ}, {δ, ϵ, η}, {λ, μ, ν}})).{(Subscript[p, 1]),(Subscript[p, 2]),(Subscript[p, 3])}](Subscript[𝔼, {}->{i,j}])[1,0,ϵSeries[0,(Subscript[p, j])(Subscript[x, j])]]//(Subscript[m, 1,i->1])//(Subscript[m, 1,2->1])//(Subscript[m, 1,j->1])//(Subscript[m, 1,3->1]))[[3,2]]/.(Subscript[(x|p), _])->0]

𝔼@Γ[ω,{(Subscript[x, 1]),(Subscript[x, 2]),(Subscript[x, 3])}.(({{α, β, γ}, {δ, ϵ, η}, {λ, μ, ν}})).{(Subscript[p, 1]),(Subscript[p, 2]),(Subscript[p, 3])}](Subscript[Rp, i,j])//(Subscript[m, 1,i->1])//(Subscript[m, 1,2->1])//(Subscript[m, 1,j->1])//(Subscript[m, 1,3->1])

Simplify[(β γ-T β γ-T (γ^2)+(T^2) (γ^2)-γ ϵ-β γ ϵ+(γ^2) ϵ+T (γ^2) ϵ-(γ^2) (ϵ^2)-β η+(β^2) η+2 T γ η-β γ η-T β γ η-γ ϵ η+2 β γ ϵ η+β (η^2)-(β^2) (η^2))/(2-4 β+2 (β^2)-4 γ ϵ+4 β γ ϵ+2 (γ^2) (ϵ^2)-4 η+8 β η-4 (β^2) η+4 γ ϵ η-4 β γ ϵ η+2 (η^2)-4 β (η^2)+2 (β^2) (η^2))]

(IdentityMatrix[3]-(({{α, β, γ}, {δ, ϵ, η}, {λ, μ, ν}})))//Det//Simplify

Solving for R, C, $k=2

$k=2;
{(Subscript[R, 1,2]),(Subscript[C, 1])}
Short[RMoves,20]

unknowns=Cases[{(Subscript[R, 1,2]),(Subscript[(OverBar[R]), 1,2]),(Subscript[C, 1]),(Subscript[(OverBar[C]), 1])},(Subscript[(c|d|e|f), $k,_]),∞]//Union

Short[errors=CCF/@Cases[RMoves,  a_==b_ :> a-b], 25]

Short[#,10]&[eqns=Thread[0==Union@@(CoefficientRules[#,{(Subscript[x, 1]),(Subscript[x, 2]),(Subscript[x, 3]),(Subscript[p, 1]),(Subscript[p, 2]),(Subscript[p, 3])}][[;;,2]]& /@ errors)]]

{sol}=Solve[eqns,unknowns]

sol/.(a_->b_):>(a=b)

Cases[{(Subscript[R, 1,2]),(Subscript[(OverBar[R]), 1,2]),(Subscript[C, 1]),(Subscript[(OverBar[C]), 1])},(Subscript[(c|d|e|f), $k,_]),∞]//Union

{Z1,Z2}=ZF/@{Knot[10,106],Knot[12,NonAlternating,369]}

{Z1[[3,2]]==Z2[[3,2]], Z1[[3,3]]-Z2[[3,3]]}//Simplify

{(Subscript[C, 1]),(Subscript[(OverBar[C]), 1]),CF[CF[(Subscript[Rp, 1,2])/.T->(T^(-1))][[3,3]]-CF[(Subscript[(OverBar[Rp]), 1,2])][[3,3]]]}/.{(Subscript[c, 2,2])->0,(Subscript[c, 2,5])->0,(Subscript[c, 2,10])->1/8,(Subscript[c, 2,11])->-1/8,(Subscript[c, 2,26])->1/8}

{(Subscript[c, 2,2])=0,(Subscript[c, 2,5])=0,(Subscript[c, 2,10])=1/8,(Subscript[c, 2,11])=-1/8,(Subscript[c, 2,26])=1/8};
{(Subscript[R, 1,2]),(Subscript[(OverBar[R]), 1,2]),(Subscript[R, 1,2])/.T->(T^(-1)),(Subscript[C, 1]),(Subscript[(OverBar[C]), 1])}//CF//Column

CF[(Subscript[R, 1,2])/.T->(T^(-1))][[3,3]]-CF[(Subscript[(OverBar[R]), 1,2])][[3,3]]

Factor/@(Subscript[Rp, 1,2])[[3]]

Simplify/@(Subscript[Rp, 1,2])[[3]]

RMoves

Solving for R, C, $k=3

$k=3;
{(Subscript[R, 1,2]),(Subscript[C, 1])}

unknowns=Cases[{(Subscript[R, 1,2]),(Subscript[(OverBar[R]), 1,2]),(Subscript[C, 1]),(Subscript[(OverBar[C]), 1])},(Subscript[(c|d|e|f), $k,_]),∞]//Union

Short[errors=CCF/@Cases[RMoves,  a_==b_ :> a-b], 25]

Short[#,10]&[eqns=Thread[0==Union@@(CoefficientRules[#,{(Subscript[x, 1]),(Subscript[x, 2]),(Subscript[x, 3]),(Subscript[p, 1]),(Subscript[p, 2]),(Subscript[p, 3])}][[;;,2]]& /@ errors)]]

{sol}=Solve[eqns,unknowns]

sol/.(a_->b_):>(a=b)

Cases[{(Subscript[R, 1,2]),(Subscript[(OverBar[R]), 1,2]),(Subscript[C, 1]),(Subscript[(OverBar[C]), 1])},(Subscript[(c|d|e|f), $k,_]),∞]//Union

CF[{(Subscript[C, 1]),((Subscript[C, 1])[[3,4]]/.T->(T^(-1)))+(Subscript[(OverBar[C]), 1])[[3,4]],((Subscript[Rp, 1,2])/.T->(T^(-1)))[[3,4]]+(Subscript[(OverBar[Rp]), 1,2])[[3,4]]}/.{(Subscript[c, 3,26])->-1/8,(Subscript[c, 3,50])->1/24,(Subscript[c, 3,11])->1/16+(Subscript[c, 3,10])}]

CF[(Subscript[Rp, 1,2])/.{(Subscript[c, 3,26])->-1/8,(Subscript[c, 3,50])->1/24,(Subscript[c, 3,11])->1/16+(Subscript[c, 3,10])}]

CF[(Subscript[Rp, 1,2])/.{(Subscript[c, 3,26])->-1/8,(Subscript[c, 3,50])->1/24,(Subscript[c, 3,11])->1/16+(Subscript[c, 3,10])}/.{(Subscript[c, 3,2])->0, (Subscript[c, 3,5])->0,(Subscript[c, 3,10])->-1/32}]

Slow G

α=4;β=4;

rvk=RVK[K]

n=Length[rvk[[1]]]

ζ=Times@@rvk[[1]]/.{Xp[i_,j_]:>(Subscript[R0, i,j]),Xm[i_,j_]:>(Subscript[(OverBar[R0]), i,j])}

ζ*=(Subscript[𝔼, {}->{0}⋃Table[i-1/2,{i,2n+1}]])[1,0,ϵSeries[0,(Subscript[p, α-1/2])(Subscript[x, β-1/2])]]

Do[ζ=ζ//(Subscript[m, 0,k->0]),{k,1/2,2n+1/2,1/2}];
ζ

Factor[ζ[[3,2]]/.(Subscript[(x|p), 0])->0]

Fast (Subscript[ρ, 1])

K=GST48;
Alexander[K][T]

CF/@{(Subscript[Rp, 1,2]),(Subscript[(OverBar[Rp]), 1,2]),(Subscript[C, 1]),(Subscript[(OverBar[C]), 1])}

PAB1[K_]:=Module[{rvk,n,B,c,s,i,j,ρ0,G,ρ1},
rvk=RVK[K]; n=Length[rvk[[1]]]; B=Table[0,2n,2n+1];
Do[
s=If[Head[c]===Xp,1,-1]; {i,j}=List@@c;
B[[i,{i,i+1}]]={1,-1}; B[[j,{j,j+1,i+1}]]={1,-(T^(-s)),(T^(-s))-1},
{c,rvk[[1]]}];
ρ0=Det[B[[;;,2;;]]]//Factor;
G=Table[0,2n,2n]; G[[;;,;;2n-1]]=Factor@Inverse[B[[;;,2;;]]][[;;,2;;2n]];
ρ1=Factor@Plus[
Sum[
s=If[Head[c]===Xp,1,-1]; {i,j}=List@@c;
s(((1-(T^s))/2)G[[i,i]]G[[i,j]]-(1/2)(G[[i,i]]G[[j,j]]+G[[i,j]]G[[j,i]])+(((T^(2s))-(T^s))/2)((G[[i,j]])^2)+(T^s)(G[[i,j]]G[[j,j]])),{c,rvk[[1]]}],
Sum[((rvk[[2,k]])/2)G[[k-1,k-1]],{k,2,2n}] ];
{ρ0,ρ1} ]

Timing@PAB1[K]

Timing@Factor@ZF[K][[3,2]]