An Alexander-Determinant-PolyTime Puzzle

Pensieve Header: An Alexander-Determinant-PolyTime Puzzle, based on Projects/WKO/wA.nb

<< KnotTheory`

The Program and a Test Run on Knot[8,17]

K=Knot[8,17];
Alexander[K][X]

Generating Gauss Codes

GC[K_] := GC @@ (
PD[K] /. X[i_,j_,k_,l_] :> If[PositiveQ[X[i,j,k,l]],
Ar[l,i,+1], Ar[j,i,-1]
]
)

GC[K]

Generating the Trapping Matrix

Tij[Ar[ti_,hi_,si_], Ar[tj_,hj_,sj_]] := If[
ti<hj<hi || hi<hj<ti,
1,0
];
T[K_] := Module[
{gc=GC[K]},
Outer[Tij,List@@gc, List@@gc]
]

T[K] // MatrixForm

The Diagonal Matrix of Signs S

Si[Ar[ti_,hi_,si_]] := Sign[hi-ti]*si;
S[K_] := DiagonalMatrix[Si /@ (List @@ GC[K])];
S0[K_] := MatrixExp[-Log[X]S[K]];
S1[K_] := S0[K] - IdentityMatrix[Crossings[K]]

MatrixForm /@ {S[K], S0[K], S1[K]}

wA

M[K_] := IdentityMatrix[Crossings[K]] - T[K].S1[K];
M[K] // MatrixForm

wA[K_] := Det[M[K]];
wA[K]

Free Play

MatrixForm[
S0[K]/X /. X-> 1/Sqrt[X]
]

MatrixForm[Expand[
M[K].(S0[K]/X /. X-> 1/Sqrt[X])
] /. X-> X+1]