Pensieve header: Testing the KnotSignature function. Continued pensieve://Projects/Signatures/.

<< KnotTheory`

KS[PD[Loop[_]]]=0;
KS[pd_PD]:=KS[pd]=Module[{spd,a,s=0,c,cs,A,es},spd=(Times@@pd)/.X[i_,j_,k_,l_]:>If[j-l==1||l-j>1,Xp,Xm][i,j,k,l];
cs=spd/.{Xp[i_,j_,k_,l_]:>a[j,++s,i]a[k,++s,-j]a[-l,++s,-k]a[-i,++s,l],Xm[i_,j_,k_,l_]:>a[-j,++s,i]a[k,++s,j]a[l,++s,-k]a[-i,++s,-l]}//.a[i_,x__,j_]a[j_,y__,k_]:>a[i,x,y,k]/.a[i_,x__,j_]:>a[x];
A=Table[0,{Length[cs]},{Length[cs]}];
Do[indices=Position[cs,#][[1,1]]&/@(4i-4+{1,2,3,4});
A[[indices,indices]]+=If[Head[spd[[i]]]===Xp,{{0,0,0,0},{1,-1,0,0},{0,-1,0,1},{-1,2,0,-1}},{{1,-1,0,0},{0,0,0,0},{-2,1,1,0},{1,0,-1,0}}],{i,Length[spd]}];
es=Re[Eigenvalues[N[A+Transpose[A],40]]]/.x_Real/;Abs[x]<(10^(-20))->0;
-Plus@@Sign/@es]
KS[K_]:=KS[PD[K]]

Total[(KS[#]==KnotSignature[#])&/@AllKnots[]]

Clear[KS1];
KS1[PD[Loop[_]]]=0;
KS1[pd_PD]:=KS1[pd]=Module[{spd,a,s=0,c,cs,A},spd=(Times@@pd)/.X[i_,j_,k_,l_]:>If[j-l==1||l-j>1,Xp,Xm][i,j,k,l];
cs=spd/.{
Xp[i_,j_,k_,l_]:>a[j,++s,i]a[k,++s,-j]a[-l,++s,-k]a[-i,++s,l],Xm[i_,j_,k_,l_]:>a[-j,++s,i]a[k,++s,j]a[l,++s,-k]a[-i,++s,-l]
}//.a[i_,x__,j_]a[j_,y__,k_]:>a[i,x,y,k]/.a[i_,x__,j_]:>a[x];
A=Table[0,{Length[cs]},{Length[cs]}];
Do[indices=Position[cs,#][[1,1]]&/@(4i-4+{1,2,3,4});
A[[indices,indices]]+=If[Head[spd[[i]]]===Xp,(({{0, 0, 0, 0}, {1, -1, 0, 0}, {0, -1, 0, 1}, {-1, 2, 0, -1}})),(({{1, -1, 0, 0}, {0, 0, 0, 0}, {-2, 1, 1, 0}, {1, 0, -1, 0}}))],
{i,Length[spd]}
];
Total[If[#>0,-1,1]& /@ DeleteCases[Eigenvalues[A+Transpose[A]],0]]
]
KS1[K_]:=KS1[PD[K]]

Total[(KS1[#]==KnotSignature[#])&/@AllKnots[]]

t=f=0; fails1={};
Monitor[
Do[If[KS1[K]==KnotSignature[K],++t,++f; AppendTo[fails1,K]],{K,AllKnots[{3,16}]}],
{K,t,f}
];
{t,f}

{t,f,fails1}

Sample Runs

pd=PD@Knot[3,1]

spd=(Times@@pd)/.X[i_,j_,k_,l_]:>If[j-l==1||l-j>1,Xp,Xm][i,j,k,l]

s=0;
cs=spd/.{
Xp[i_,j_,k_,l_]:>a[j,++s,i]a[k,++s,-j]a[-l,++s,-k]a[-i,++s,l],Xm[i_,j_,k_,l_]:>a[-j,++s,i]a[k,++s,j]a[l,++s,-k]a[-i,++s,-l]
}//.a[i_,x__,j_]a[j_,y__,k_]:>a[i,x,y,k]/.a[i_,x__,j_]:>a[x]

MatrixForm[A=Table[0,{Length[cs]},{Length[cs]}]]

Do[
indices=Echo[Position[cs,#][[1,1]]&/@(4i-{3,2,1,0})];
A[[indices,indices]]+=If[Head[spd[[i]]]===Xp,(({{0, 0, 0, 0}, {1, -1, 0, 0}, {0, -1, 0, 1}, {-1, 2, 0, -1}})),(({{1, -1, 0, 0}, {0, 0, 0, 0}, {-2, 1, 1, 0}, {1, 0, -1, 0}}))];
Echo@MatrixForm[A],
{i,Length[spd]}
]

Eigenvalues[A+Transpose[A]]

Total[If[#>0,-1,1]& /@ DeleteCases[Eigenvalues[A+Transpose[A]],0]]

pd=PD@Knot[8,17]

spd=(Times@@pd)/.X[i_,j_,k_,l_]:>If[j-l==1||l-j>1,Xp,Xm][i,j,k,l]

s=0;
cs=spd/.{
Xp[i_,j_,k_,l_]:>a[j,++s,i]a[k,++s,-j]a[-l,++s,-k]a[-i,++s,l],Xm[i_,j_,k_,l_]:>a[-j,++s,i]a[k,++s,j]a[l,++s,-k]a[-i,++s,-l]
}//.a[i_,x__,j_]a[j_,y__,k_]:>a[i,x,y,k]/.a[i_,x__,j_]:>a[x]

MatrixForm[A=Table[0,{Length[cs]},{Length[cs]}]]

Do[
Echo@i;
indices=Echo[Position[cs,#][[1,1]]&/@(4i-{3,2,1,0})];
A[[indices,indices]]+=If[Head[spd[[i]]]===Xp,
{{0,0,0,0},{1,-1,0,0},{0,-1,0,1},{-1,2,0,-1}},
{{1,-1,0,0},{0,0,0,0},{-2,1,1,0},{1,0,-1,0}}
];
Echo@MatrixForm[A],
{i,Length[spd]}
]

Eigenvalues[A+Transpose[A]]//N

Total[If[#>0,-1,1]& /@ DeleteCases[Eigenvalues[A+Transpose[A]],0]]