Pensieve header: The Kerler Algebra and the Alexander polynomial.

Once[<<KnotTheory`];
HL[ℰ_] := Style[ℰ, Background -> If[TrueQ@ℰ,,]];

MT=(({{\[Placeholder], a, b, c, d, ka, kb, kc, kd}, {a, a, b, 0, 0, ka, kb, 0, 0}, {b, 0, 0, a, b, 0, 0, -ka, -kb}, {c, c, d, 0, 0, -kc, -kd, 0, 0}, {d, 0, 0, c, d, 0, 0, kc, kd}, {ka, ka, kb, 0, 0, a, b, 0, 0}, {kb, 0, 0, ka, kb, 0, 0, -a, -b}, {kc, kc, kd, 0, 0, -c, -d, 0, 0}, {kd, 0, 0, kc, kd, 0, 0, c, d}}));
ℰ_//(Subscript[m, i_,j_->k_]):=Expand[ℰ]/.Flatten@Table[(Subscript[MT[[α,1]], i])(Subscript[MT[[1,β]], j])->(MT[[α,β]]/.v:(a|b|c|d|ka|kb|kc|kd):>(Subscript[v, k])),{α,2,9},{β,2,9}];

KBasis[{i_}]:={(Subscript[a, i]),(Subscript[b, i]),(Subscript[c, i]),(Subscript[d, i]),(Subscript[ka, i]),(Subscript[kb, i]),(Subscript[kc, i]),(Subscript[kd, i])};
KBasis[{i_,is__}]:=Flatten@Outer[Times,KBasis[{i}],KBasis[{is}]]

(Subscript[η, i_]):=(Subscript[a, i])+(Subscript[d, i]);
(Subscript[γ, i_]):=(Subscript[ka, i])+(Subscript[kd, i]);

lhs=(Subscript[η, 1])KBasis[{2}]//(Subscript[m, 1,2->1]);
HL[lhs==KBasis[{1}]]

lhs=(Subscript[η, 1])KBasis[{2}]//Expand//(Subscript[m, 1,2->1]);
HL[lhs==KBasis[{1}]]

Short[lhs=KBasis[{1,2,3}]//(Subscript[m, 1,2->1])//(Subscript[m, 1,3->1])]
rhs=KBasis[{1,2,3}]//(Subscript[m, 2,3->2])//(Subscript[m, 1,2->1!]);
lhs==rhs//HL

(Subscript[R, i_,j_]):=(Subscript[a, i])(Subscript[a, j])+(Subscript[d, i])(Subscript[a, j])+T (Subscript[a, i])(Subscript[d, j])-(1- T)(Subscript[kc, i])(Subscript[kb, j])-T (Subscript[d, i])(Subscript[d, j])

Short[lhs=(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])];
rhs=(Subscript[R, 2,3])(Subscript[R, 1,4])(Subscript[R, 5,6])//(Subscript[m, 1,5->1])//(Subscript[m, 2,6->2])//(Subscript[m, 3,4->3]);
lhs==rhs//HL

(Subscript[(OverBar[R]), i_,j_]):=(Subscript[a, i])(Subscript[a, j])+(Subscript[d, i])(Subscript[a, j])+(T^(-1))(Subscript[a, i])(Subscript[d, j])-(1-(T^(-1)))(Subscript[kc, i])(Subscript[kb, j])-(T^(-1)) (Subscript[d, i])(Subscript[d, j])

Short[lhs=(Subscript[R, 1,2])(Subscript[(OverBar[R]), 3,4])//(Subscript[m, 1,3->1])//(Subscript[m, 2,4->2])]
rhs=(Subscript[η, 1])(Subscript[η, 2])//Expand;
lhs==rhs//HL

Short[lhs=(Subscript[R, 1,2])(Subscript[(OverBar[R]), 3,4])//(Subscript[m, 1,3->1])//(Subscript[m, 4,2->2])]
rhs=(Subscript[η, 1])(Subscript[η, 2])//Expand;
Simplify[lhs-rhs]

lhs=(Subscript[R, 1,4])(Subscript[(OverBar[R]), 5,2])(Subscript[γ, 3])//(Subscript[m, 2,4->2])//(Subscript[m, 1,3->1])//(Subscript[m, 1,5->1])
rhs=(Subscript[γ, 1])(Subscript[η, 2])//Expand;
lhs==rhs//HL

RVK and Z

RVK, rot, Z modified from 2016-09/OneSmidgen.nb. See also in AP/Projects/SL2Invariant/.

Some details of the code below are at http://drorbn.net/bbs/show?shot=Dror-160920-151350.jpg.

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={0},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=0,k<2n,++k,If[k==0∨FreeQ[front,-k],
front=Flatten@Replace[front,k->(xs/.{
Xp[k+1,l_]|Xm[l_,k+1]:>{l,k+1,1-l},
Xp[l_,k+1]|Xm[k+1,l_]:>(++rots[[l]];{1-l,k+1,l}),
_Xp|_Xm:>{}
}), {1}],
Cases[front,k|-k]/.{k,-k}:>--rots[[k+1]];
]];
RVK[xs,rots] ];
RVK[K_]:=RVK[PD[K]];

(Subscript[rot, i_])[n_]:=(Piecewise[{{(Subscript[η, i]), EvenQ[n]}, {(Subscript[γ, i]), OddQ[n]}}])

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])})((Subscript[ka, 0])-(Subscript[kd, 0]))//(Subscript[m, j,0->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@ζ
]

K=Knot[8,17]; Factor@Alexander[K][T]
z=Z[K]

Timing@Union@Table[Simplify[Alexander[K][T]((Subscript[a, 1])+(Subscript[d, 1]))/Z[K]],{K,AllKnots[{3,10}]}]

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 ]

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

Timing@Union@Table[Simplify[Alexander[K][T]((Subscript[a, 1])+(Subscript[d, 1]))/ZF[K]],{K,AllKnots[{3,10}]}]