Jones

δ[b_,c_]:=If[b===c,1,0];
Simp[Z_]:=Expand[Z](*/.{(Subscript[e[2,2], i_]):>1-(Subscript[e[1,1], i])}//Expand*)
(Subscript[m, i_,j_->k_])[Z_]:=Expand[Z]/.{(Subscript[e[a_,b_], i])(Subscript[e[c_,d_], j]):>δ[b,c](Subscript[e[a,d], k]),(Subscript[e[a_,b_], i]):>(Subscript[e[a,b], k]),(Subscript[e[a_,b_], j]):>(Subscript[e[a,b], k])}//Simp
(Subscript[R, i_,j_]):=(q (Subscript[e[1,1], i]) (Subscript[e[1,1], j])-(((Subscript[e[1,2], i]) (Subscript[e[2,1], j]))/(q^3))+q (Subscript[e[1,2], i]) (Subscript[e[2,1], j])+(((Subscript[e[1,1], j]) (Subscript[e[2,2], i]))/q)+(((Subscript[e[1,1], i]) (Subscript[e[2,2], j]))/q)+q (Subscript[e[2,2], i]) (Subscript[e[2,2], j]))//Simp;

(Subscript[(OverBar[R]), i_,j_]):=((((Subscript[e[1,1], i]) (Subscript[e[1,1], j]))/q)-(((-1+(q^4)) (Subscript[e[1,2], i]) (Subscript[e[2,1], j]))/q)+q (Subscript[e[1,1], j]) (Subscript[e[2,2], i])+q (Subscript[e[1,1], i]) (Subscript[e[2,2], j])+(((Subscript[e[2,2], i]) (Subscript[e[2,2], j]))/q))//Simp;

(Subscript[κ, i_]) := (q^2) (Subscript[e[1,1], i])+ (q^(-2)) (Subscript[e[2,2], i])//Simp;
(Subscript[(OverBar[κ]), i_]) := (q^(-2)) (Subscript[e[1,1], i])+(q^2) (Subscript[e[2,2], i])//Simp;

(Subscript[id, i_]):= (Subscript[e[1,1], i])+ (Subscript[e[2,2], i]);

(Subscript[Kink, i_]):=((Subscript[R, 1,3])(Subscript[(OverBar[κ]), 2])//(Subscript[m, 1,2->1])//(Subscript[m, 1,3->i]))//Simp;
(Subscript[(OverBar[Kink]), i_]):=((Subscript[(OverBar[R]), 3,1])(Subscript[(OverBar[κ]), 2])//(Subscript[m, 1,2->1])//(Subscript[m, 1,3->i]))//Simp;

On verifie les axiomes:

((Subscript[(OverBar[R]), 1,2])(Subscript[R, 3,4])//(Subscript[m, 1,3->1])//(Subscript[m, 2,4->2]))-(Subscript[id, 1])(Subscript[id, 2])//Simplify
(((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, 1,6])(Subscript[R, 2,3])(Subscript[R, 4,5])//(Subscript[m, 1,4->1])//(Subscript[m, 2,5->2])//(Subscript[m, 3,6->3])))
(((Subscript[κ, 1])(Subscript[κ, 2])(Subscript[R, 3,4])(Subscript[(OverBar[κ]), 5])(Subscript[(OverBar[κ]), 6])//(Subscript[m, 1,3->1])//(Subscript[m, 1,5->1])//(Subscript[m, 2,4->2])//(Subscript[m, 2,6->2]))-(Subscript[R, 1,2]))//Simplify
(((Subscript[κ, 1])(Subscript[κ, 2])(Subscript[(OverBar[R]), 3,4])(Subscript[(OverBar[κ]), 5])(Subscript[(OverBar[κ]), 6])//(Subscript[m, 1,3->1])//(Subscript[m, 1,5->1])//(Subscript[m, 2,4->2])//(Subscript[m, 2,6->2]))-(Subscript[(OverBar[R]), 1,2]))//Simplify
(((Subscript[(OverBar[R]), 1,4])(Subscript[R, 3,2])(Subscript[κ, 6])//(Subscript[m, 1,3->1])//(Subscript[m, 2,6->2])//(Subscript[m, 2,4->2]))-(Subscript[id, 1])(Subscript[κ, 2]))//Expand//Simplify
(((Subscript[(OverBar[R]), 5,1])(Subscript[R, 2,3])(Subscript[(OverBar[κ]), 4])//(Subscript[m, 1,3->1])//(Subscript[m, 2,4->2])//(Subscript[m, 2,5->2]))- (Subscript[id, 1])(Subscript[(OverBar[κ]), 2]))//Expand//Simplify
((Subscript[κ, 1])(Subscript[(OverBar[κ]), 2])//(Subscript[m, 1,2->1]))-(Subscript[id, 1])//Simplify//Expand
(((Subscript[R, 1,3])(Subscript[(OverBar[κ]), 2])//(Subscript[m, 1,2->1])//(Subscript[m, 1,3->1]))-((Subscript[R, 3,1])(Subscript[κ, 2])//(Subscript[m, 1,2->1])//(Subscript[m, 1,3->1])))//Expand

Positive trefoil

(Subscript[Kink, 1])
(*FramingCorr=(Subscript[(OverBar[Kink]), 8])(Subscript[(OverBar[Kink]), 9])(Subscript[(OverBar[Kink]), 10])//(Subscript[m, 8,9->8])//(Subscript[m, 8,10->8]);*)
Z31=(Subscript[R, 1,5])(Subscript[R, 6,2])(Subscript[R, 3,7])(Subscript[(OverBar[κ]), 4]);
Do[Z31=Z31//(Subscript[m, 1,i->1]),{i,2,7}]
Z31//Simplify

FramingCorr=(Subscript[(OverBar[Kink]), 2])(Subscript[(OverBar[Kink]), 3])(Subscript[(OverBar[Kink]), 4])//(Subscript[m, 2,3->2])//(Subscript[m, 2,4->2]);
Z31Corr=Z31 FramingCorr//(Subscript[m, 1,2->1])//Simplify

Jones[Mirror@Knot[3,1]][t]

(Subscript[Coeff, i_])[Z_]:=Module[{Cons},Cons =  (1/2)Z/.{(Subscript[e[1,1], i])->1,(Subscript[e[2,2], i])->1,(Subscript[e[1,2], i])->0,(Subscript[e[2,1], i])->0}]//Expand

Z31Corr//(Subscript[Coeff, 1])

Jones[Mirror@Knot[3,1]][(q^(-4))]

Comparing to the Jones polynomial from the KnotTheory package.

Once[AppendTo[$Path,FileNameJoin[{"/Users/jorge/MEGA/PhD/MathematicaNotebooks/KnotTheory"}]];
<<KnotTheory` ; 
];

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

rot[i_,0]:=1;
rot[i_,n_]:=rot[i,n];
rot[i_,n_]:=Module[{j},
rot[i,n]=If[n>0,rot[i,n-1](Subscript[κ, j]),rot[i,n+1](Subscript[(OverBar[κ]), j])]//(Subscript[m, i,j->i])];

Width[pd_PD]:=Max[Length/@FoldList[Complement[#1⋃#2,#1⋂#2]&, {}, List@@List@@@pd]]

ThinPosition[K_]:=Module[{todo,done,pd,cc},
todo=List@@PD@K; done={}; pd=PD[];
While[todo=!={},
AppendTo[pd,cc=RandomChoice@MaximalBy[todo, Length[done⋂List@@#]&]];
todo=DeleteCases[todo,cc];
done=done⋃List@@cc];
pd ];
ThinPosition[K_,n_] := First@MinimalBy[Table[ThinPosition[K], n], Width];

Z[K_] := Z[RVK@ThinPosition[K,100]];
Z[rvk_RVK] := Monitor[ Module[{ζ,done,st,cc, χ,i,j,k},
ζ=1; done={}; st=Range[2Length[rvk[[1]]]]; $M={};
Do[AppendTo[$M,cc];
{i,j}=List@@cc;
χ=(cc/.{_Xp:>(Subscript[R, i,j])(Subscript[(OverBar[Kink]), 0]),_Xm:>(Subscript[(OverBar[R]), i,j])(Subscript[Kink, 0])})//(Subscript[m, j,0->j]);
Do[χ=(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},
{cc,rvk[[1]]}
];
ζ 
], {Length@$M,$M}]

Z[Mirror@Knot[3,1]]//(Subscript[Coeff, 1])//Simplify

{#,Z[#]//(Subscript[Coeff, 1]), Jones[#][(q^(-4))]}&/@AllKnots[{1,7}]//MatrixForm

Alexander:

δ[b_,c_]:=If[b===c,1,0];
Simp[Z_]:=Expand[Z](*/.{(Subscript[e[2,2], i_]):>1-(Subscript[e[1,1], i])}//Expand*)
(Subscript[m, i_,j_->k_])[Z_]:=Expand[Z]/.{(Subscript[e[a_,b_], i])(Subscript[e[c_,d_], j]):>δ[b,c](Subscript[e[a,d], k]),(Subscript[e[a_,b_], i]):>(Subscript[e[a,b], k]),(Subscript[e[a_,b_], j]):>(Subscript[e[a,b], k])}//Simp
(Subscript[R, i_,j_]):=(Subscript[e[1,1], i]) ((q^(-2))(Subscript[e[1,1], j]) + (q^(-1)) (Subscript[e[2,2], j]) ) + (Subscript[e[2,2], i])(q (Subscript[e[1,1], j])-(q^2) (Subscript[e[2,2], j]))+ ((q^(-2))-(q^2))(Subscript[e[1,2], i])(Subscript[e[2,1], j])//Simp;

(Subscript[(OverBar[R]), i_,j_]):=(Subscript[e[1,1], i]) ((q^2)(Subscript[e[1,1], j]) + q (Subscript[e[2,2], j]) ) + (Subscript[e[2,2], i])((q^(-1))  (Subscript[e[1,1], j])-(q^(-2)) (Subscript[e[2,2], j]))+ ((q^2)-(q^(-2)))(Subscript[e[1,2], i])(Subscript[e[2,1], j])//Simp;

(Subscript[κ, i_]) := (q^2) (Subscript[e[1,1], i])- (q^2) (Subscript[e[2,2], i])//Simp;
(Subscript[(OverBar[κ]), i_]) := (q^(-2)) (Subscript[e[1,1], i])-(q^(-2)) (Subscript[e[2,2], i])//Simp;

(Subscript[id, i_]):= (Subscript[e[1,1], i])+ (Subscript[e[2,2], i]);

(Subscript[Kink, i_]):=((Subscript[R, 1,3])(Subscript[(OverBar[κ]), 2])//(Subscript[m, 1,2->1])//(Subscript[m, 1,3->i]))//Simp;
(Subscript[(OverBar[Kink]), i_]):=((Subscript[(OverBar[R]), 3,1])(Subscript[(OverBar[κ]), 2])//(Subscript[m, 1,2->1])//(Subscript[m, 1,3->i]))//Simp;

On verifie les axiomes:

((Subscript[(OverBar[R]), 1,2])(Subscript[R, 3,4])//(Subscript[m, 1,3->1])//(Subscript[m, 2,4->2]))-(Subscript[id, 1])(Subscript[id, 2])//Simplify
(((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, 1,6])(Subscript[R, 2,3])(Subscript[R, 4,5])//(Subscript[m, 1,4->1])//(Subscript[m, 2,5->2])//(Subscript[m, 3,6->3])))
(((Subscript[κ, 1])(Subscript[κ, 2])(Subscript[R, 3,4])(Subscript[(OverBar[κ]), 5])(Subscript[(OverBar[κ]), 6])//(Subscript[m, 1,3->1])//(Subscript[m, 1,5->1])//(Subscript[m, 2,4->2])//(Subscript[m, 2,6->2]))-(Subscript[R, 1,2]))//Simplify
(((Subscript[κ, 1])(Subscript[κ, 2])(Subscript[(OverBar[R]), 3,4])(Subscript[(OverBar[κ]), 5])(Subscript[(OverBar[κ]), 6])//(Subscript[m, 1,3->1])//(Subscript[m, 1,5->1])//(Subscript[m, 2,4->2])//(Subscript[m, 2,6->2]))-(Subscript[(OverBar[R]), 1,2]))//Simplify
(((Subscript[(OverBar[R]), 1,4])(Subscript[R, 3,2])(Subscript[κ, 6])//(Subscript[m, 1,3->1])//(Subscript[m, 2,6->2])//(Subscript[m, 2,4->2]))-(Subscript[id, 1])(Subscript[κ, 2]))//Expand//Simplify
(((Subscript[(OverBar[R]), 5,1])(Subscript[R, 2,3])(Subscript[(OverBar[κ]), 4])//(Subscript[m, 1,3->1])//(Subscript[m, 2,4->2])//(Subscript[m, 2,5->2]))- (Subscript[id, 1])(Subscript[(OverBar[κ]), 2]))//Expand//Simplify
((Subscript[κ, 1])(Subscript[(OverBar[κ]), 2])//(Subscript[m, 1,2->1]))-(Subscript[id, 1])//Simplify//Expand
(((Subscript[R, 1,3])(Subscript[(OverBar[κ]), 2])//(Subscript[m, 1,2->1])//(Subscript[m, 1,3->1]))-((Subscript[R, 3,1])(Subscript[κ, 2])//(Subscript[m, 1,2->1])//(Subscript[m, 1,3->1])))//Expand

Positive trefoil

Z31=(Subscript[R, 1,5])(Subscript[R, 6,2])(Subscript[R, 3,7])(Subscript[(OverBar[κ]), 4]);
Do[Z31=Z31//(Subscript[m, 1,i->1]),{i,2,7}]
Z31//Simplify

Jones[Mirror@Knot[3,1]][t]

Z31//(Subscript[Coeff, 1])

Alexander[Mirror@Knot[3,1]][(q^4)]

{#,Z[#]//(Subscript[Coeff, 1]), Alexander[#][(q^4)]}&/@AllKnots[{1,7}]//MatrixForm