Pensieve header: Tristram-Levine signatures via braid closures. Continued pensieve://Projects/Signatures/.

<< KnotTheory`

K=Knot[3,1];
K//PD
K//PD//Jones
K//PD//BR
K//PD//BR//PD
K//PD//BR//PD//Jones

IN[i1,j1,i2,j2] measures the upper-half-plane intersection number of the arrows (Subscript[i, 1])->(Subscript[j, 1]) and (Subscript[i, 2])->(Subscript[j, 2]). IN[1,3,2,4] is +1.

χ[cond_]:=If[TrueQ[cond],1,0];
IN[i1_,j1_,i2_,j2_]:=-χ[i1>i2]+χ[i1>j2]+χ[j1>i2]-χ[j1>j2];
IN[1,3,2,4]

SC stands for “Simple Cycle”.

β=Knot[4,1]//BR
{n=β[[1]], l=Length@β[[2]]}

SCs[β_BR]:=Module[{n=β[[1]]},
Flatten@Table[SC@@@Subsets[Flatten@Position[Abs[β[[2]]],k],{2}],{k,n-1}] ]

SCs[β]

lk[β,sc1,sc2] computes lk(sc1,(SuperPlus[sc2])) in β.

Clear[a1,a2,a3,a4];
{a1,a2,a3,a4}={1,0,-1, -1};
lk[β_BR,SC[i1_,j1_],SC[i2_,j2_]]:=Module[
{n=β[[1]],s1=Abs@β[[2,i1]],s2=Abs@β[[2,i2]]},
Which[
Abs[s2-s1]>1, 0,
s2-s1==1,a1 IN[i1,j1,j2,i2],
s1-s2==1,a2 IN[i1,j1,j2,i2],
s1==s2,a3 IN[i1+0.1,j1+0.1,i2,j2]+a4(χ[i1==i2]*χ[β[[2,i1]]>0]-χ[i1==j2]*χ[β[[2,i1]]>0]-χ[j1==i2]*χ[β[[2,j1]]>0]+χ[j1==j2]*χ[β[[2,j1]]>0])
]
];
Table[lk[β,sc1,sc2], {sc1,SCs[β]}, {sc2,SCs[β]}]//MatrixForm

SM for Seifert Matrix.

SM[β_BR]:=Module[{n=β[[1]],col,H1},
H1=Flatten@Table[
col=Flatten@Position[Abs[β[[2]]],k];
SC[First@col,#]&/@Rest[col],
{k,n-1}];
Table[lk[β,sc1,sc2], {sc1,H1}, {sc2,H1}]
];
SM[β]//MatrixForm

SM[BR@Knot[6,1]]//MatrixForm

AlexNT[K_]:=Module[{sm=SM[BR[K]]},Det[t sm-Transpose@sm]]

AlexNT[Knot[3,1]]

Collect[AlexNT[Knot[6,1]],t]

Alexander[Knot[6,1]][t]

AlexNT[PD@BR[3,{1,2,1,2}]]

Alexander[BR[3,{1,2,1,2}]][t]

K=Knot[10,100];
Alexander[K][t]
Collect[AlexNT[K],t]
Simplify[((Alexander[K][t])/(AlexNT[K]))]

Union@Table[Simplify[((Alexander[K][t])/(AlexNT[K]))], {K,AllKnots[]}]

MatrixSignature[M_?MatrixQ] := 2Length@Select[Eigenvalues[M], #>0&]-Length[M]

MatrixSignature/@ {(({{1, 0}, {0, 1}})),(({{1, 0}, {0, -1}})),(({{-1, 0}, {0, -1}}))}

KSNT[K_]:=Module[{M=SM[BR[K]]}, MatrixSignature[M+Transpose[M]]]

KSNT/@AllKnots[{3,8}]

KnotSignature/@AllKnots[{3,8}]

Union[(KSNT[#]+KnotSignature[#])&/@AllKnots[{3,11}]]

TLS[K_,ω_]:=Module[{M=SM[BR[K]]}, MatrixSignature[(1-ω)M+(1-Conjugate@ω)Transpose[M]]]

K=Knot[3,1]; Plot[TLS[K,(E^(I t))], {t,0,2π}]

Table[ Plot[TLS[K,(E^(I t))], {t,0,2π},PlotLabel->K], {K,AllKnots[{3,11}]}]