Pensieve header: Tristram-Levine signatures for braid closures. Continues pensieve://2021-02/.

SetDirectory["C:\\drorbn\\AcademicPensieve\\Projects\\Signatures"];
<< Common.m

Tristram-Levine for Braid Closures

{\def\nbpdfText#1{\vskip 1mm\par\noindent\includegraphics[width=\linewidth]{#1}}

}

IN[i,j,k,l] measures the upper-half-plane intersection number of the arrows i->j and k->l. IN[1,3,2,4] is +1.

χ[cond_]:=If[TrueQ[cond],1,0];
IN[i_,j_,k_,l_]:=χ[i>l]+χ[j>k]-χ[i>k]-χ[j>l]

SC stands for “Simple Cycle”.

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

Knot[4,1]//BR // SCs

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

lk[β_BR,SC[i_,j_],SC[k_,l_]]:=Module[
{n=β[[1]],s1=Abs@β[[2,i]],s2=Abs@β[[2,k]]},
Which[
s2-s1==1,IN[i,j,l,k],
s1==s2,χ[β[[2,i]]>0](χ[i==l]-χ[i==k])+χ[β[[2,j]]>0](χ[j==k]-χ[j==l])-IN[i+0.1,j+0.1,k,l],
True, 0] ]

Block[{β=Knot[4,1]//BR}, Table[lk[β,sc1,sc2], {sc1,SCs[β]}, {sc2,SCs[β]}]//MatrixForm]

SM for Seifert Matrix.

SM[β_BR]:=SM[β]=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[BR@Knot[6,1]]//MatrixForm

AlexFromSM[K_]:=Module[{A=SM@BR@K},Det[t A-A\[Transpose]]]

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

SignatureFromSM[K_]:=Module[{A=SM@BR@K}, MatrixSignature[A+A\[Transpose]]]

SignatureFromSM/@AllKnots[{3,9}]

-KnotSignature/@AllKnots[{3,9}]

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

{\def\nbpdfOutput#1{\vskip 1mm\[ \includegraphics[width=0.5\linewidth]{#1} \]}

Plot[TLSFromSM[Knot@"K12a422",(E^(I t))],{t,0,2π}]

}