Pensieve header: Other near-Wirtinger matrices to produce the Alexander polynomial.

Programs

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

Multi-Alexanders

Als[K_Knot|K_PD]:=Als[GD@@Cases[PD@K,x_X:>(Piecewise[{{Xp[x[[4]],x[[1]]], PositiveQ@x}, {Xm[x[[2]],x[[1]]], True}}])]];
Als[gd_GD]:=(gd;
n=Length[gd];
B1=B2=B3=B4=B5=Table[0,2n,2n+1];
Do[s=If[Head[c]===Xp,1,-1]; {i,j}=List@@c;
B1[[{i,j},{i,i+1,j,j+1}]]=(({{1, -1, 0, 0}, {0, (T^s)-1, 1, -(T^s)}})); (* The Original B *)
B2[[{i,j},{i,i+1,j,j+1}]]=(({{1, -1/α, 0, 0}, {0, (T^s)-1, 1, -α (T^s)}})); (* Depth-twisting by (α^d) *)
B3[[{i,j},{i,i+1,j,j+1}]]=(({{1, -(T^s), 0, 0}, {0, (T^s)-1, 1, -1}})); (* Depth-twisting with α=(T^(-s)) *)
B4[[{i,j},{i,i+1,j,j+1}]]=(({{1, -1, 0, 0}, {0, (T^(-s))-1, 1, -(T^(-s))}}));(* B/.T->1/T *)
B5[[{i,j},{i,i+1,j,j+1}]]=(({{1, -(T^s), 0, (T^s)-1}, {0, 0, 1, -1}})), (* Vertical mirror then horizontal mirror *)
{c,List@@gd}];
(*Echo[MatrixForm/@{B3,B4}];*)
Δ1=Det[B1[[All,2;;]]];
Δ2=Det[B2[[All,2;;]]];
Δ3=Det[B3[[All,2;;]]];
Δ4=Det[B4[[All,2;;]]];
Δ5=Det[B5[[All,2;;]]];
Factor@{Δ1,Δ2,Δ3,Δ4,Δ5} )

Als/@AllKnots[{3,7}]

Als[PD[X[1,4,2,3],X[2,1,3,4]]]

Als[GD[Xp[1,3],Xp[4,2]]]

Als[GD[Xm[4,1],Xm[6,3],Xm[2,5]]]

Als[GD[Xp[4,1],Xm[6,3],Xm[2,5]]]

Als[GD[Xp[4,1],Xp[6,3],Xm[2,5]]]

Als[GD[Xp[4,1],Xp[6,3],Xp[2,5]]]

Conjugacy Tests

Als[Knot[7,7]]

Collect[Det[B1[[All,2;;]]-λ IdentityMatrix[Length[B3]]], λ, Factor]

Collect[Det[B2[[All,2;;]]-λ IdentityMatrix[Length[B3]]], λ, Factor]

Collect[Det[B3[[All,2;;]]-λ IdentityMatrix[Length[B3]]], λ, Factor]

Collect[Det[B4[[All,2;;]]-λ IdentityMatrix[Length[B3]]], λ, Factor]

Collect[Det[B5[[All,2;;]]-λ IdentityMatrix[Length[B3]]], λ, Factor]