Computing up to the nth Coefficient of the Homflypt polynomial in polynomial time

by David Ledvinka

david.ledvinka@mail.utoronto.ca

Introduction

This Mathematica notebook presents the work done by David Ledvinka at the University of Toronto under the supervision of Professor Dror Bar-Natan during the summer of 2018 to implement the algorithm in the paper  “The first coefficient of Homflypt and Kauffman polynomials: Vertigan proof of polynomial complexity using dynamic programming”  [1]  by Józef H, Przytycki. The algorithm allows one to compute the first several coefficients of the Homflypt polynomial of a knot in polynomial time, though the power of the polynomial bound increases as one tries to compute higher order coefficients. Since the definition of the Homflypt polynomial varies by convention, we will establish the following definition here:

The Homflypt polynomial is the unique assignment to every link 𝔏 an element 𝒫(𝔏)  of  ℤ[(a^(±1)),(z^(±1))]  such that

𝒫(a,z)(𝔘)=1

where 𝔘 is the unknot, and

a𝒫(a,z)((SubPlus[𝔏]))+(a^(-1))𝒫(a,z)((SubMinus[𝔏]))=z𝒫(a,z)((Subscript[𝔏, 0]))

for every skein triplet ((SubPlus[𝔏]),(SubMinus[𝔏]),(Subscript[𝔏, 0])).

Packages and Helper Functions

SetDirectory["C:\\drorbn\\AcademicPensieve\\People\\Ledvinka"];
<<KnotTheory`;
<<DunfieldsKnots`;

NormalizePD[K_PD]:= K/.i_Integer :> Mod[i, 2 Crossings[K]];
FlipCrossing[X[i_,j_,k_,l_]]:=If[PositiveQ[ X[i,j,k,l]],X[l,i,j,k], X[j,k,l,i]];
FirstEdge[i_,j_]:= If[Abs[j-i]==1,Min[i,j], Max[i,j]];
OrderKnot[K_PD]:= Association @@ Flatten @ (List @@ K/.X[i_,j_,k_,l_]:> {i-> X[i,j,k,l], FirstEdge[j,l]->X[i,j,k,l]});
TruncatePolynomial[P_, x_, k_]:= P/.(x^(i_))/;i>k->0;

HomflyptUpTo

HomflyptUpTo takes as input a knot K (which can be given in either PD notation, or a format which is automatically converted to PD notation by applying PD), and an even integer n, and computes the Homflypt polynomial of K up to the coefficient of (z^n) in polynomial time in the number of crossings, although the power of the polynomial bound grows as n grows.  The algorithm follows the one outlined in the paper “The first coefficient of Homflypt and Kauffman polynomials: Vertigan proof of polynomial complexity using dynamic programming”  [1] by Józef H, Przytycki, (with a few modifications and corrections).

HomflyptUpTo[K_PD, n_]:= Module[{m, L, OK, UnderCrossingQ, P, Linking},
m = 2 Crossings[K];
L = NormalizePD[K];
OK =OrderKnot[L];
UnderCrossingQ[i_]:= (First @ OK[i]==i);
P[k_,i_,j_]:=P[k,i,j] =  Expand @ Module[{t},
Piecewise[{
{1,j-i≤ 4},
{P[k,i+1,j], t = FirstEdge @@ OK[i][[{2,4}]]; Not @ UnderCrossingQ[i] ||Not[ i<t≤j]}},
If[PositiveQ[OK[i]], -(a^(-2))P[k,i+1,j] + (a^(-1)) P[k,i,j,t], -(a^2)P[k,i+1,j] + a P[k,i,j,t]]
]];
Linking[i_,j_, t_]:=Sum[If[UnderCrossingQ[l]&&(i+1≤FirstEdge @@ OK[l][[{2,4}]]≤t-1), If[PositiveQ[OK[l]],1,-1], 0],{l,t+1,j-1}];
P[0,i_,j_,t_]:=(((-(a^(-2))))^( Linking[i,j,t]))(a + ((a )^(-1)))P[ 0,i+1,t] P[0,t+1,j];
P[k_,i_,j_,t_]:= Module[{FlipCheck, e, Smooth, D, T, D0},
FlipCheck[X[a_,b_,c_,d_]]:= (e = FirstEdge[b,d];(a<i && Not[a<e<i]) ||( a ≥j && a>e > i));
Smooth[D_,s_]:= Module[{r, d1, d2, d3, A},
r= FirstEdge @@ OK[s][[{2,4}]];
d1 = i + s - (t+1); 
d2 = d1 + t - (r+1);
d3 = d2 + r - (i+1);
A=AssociationThread[Join[Range[0,i],Range[t+1,s],Range[r+1,t],Range[i+1,r],Range[s+1,m-1]]->Join[Range[0,i],Range[i,d1],Range[d1,d2],Range[d2,d3],Range[d3, m -5]]];
D/.X[a_,b_,c_,d_]:> If[MatchQ[X[a,b,c,d],OK[s]], ##&[], X[A[a],A[b],A[c],A[d]]]];
T[j]:= (a + (a^(-1)))P[k,i+1,t] P[k,t+1,j];
T[s_]:=If[UnderCrossingQ[s] && i+1≤ FirstEdge @@ OK[s][[{2,4}]]≤t-1,
D0 = Smooth[D, s]; D = D/. OK[s]:>FlipCrossing[OK[s]];
If[PositiveQ[OK[s]], (z^2) (a^(-1))HomflyptUpTo[D0,k-2]-(a^(-2))T[s + 1],(z^2) a HomflyptUpTo[D0,k-2]- (a^2)T[s+ 1]],T[s + 1]];
D = L/.x_X:>If[MatchQ[x,OK[i]],##&[], If[FlipCheck[x], FlipCrossing[x],x]]; 
 T[t+1]
];
  TruncatePolynomial[P[n,0,m],z,n]
];

HomflyptUpTo[K_,n_]:= HomflyptUpTo[PD @ K, n];

Examples

Here we compute the Homflypt polynomial of a few knot’s from the Rolfsen Table

HomflyptUpTo[Knot[8,8],0]

HomflyptUpTo[Knot[8,8],4]

HomflyptUpTo[Knot[10,20],0]

HomflyptUpTo[Knot[10,20],4]

Here we compute the Homflypt polynomial of a knot in PD notation. (The Trefoil)

HomflyptUpTo[PD[X[1,4,2,5],X[3,6,4,1],X[5,2,6,3]],0]

HomflyptUpTo[PD[X[1,4,2,5],X[3,6,4,1],X[5,2,6,3]],2]

We can take advantage of the polynomial complexity of the algorithm by computing the first parts of the Homflypt polynomial for much larger knots. To demonstrate this we use a list of knots with up to 1000 crossings provided by Professor Nathan M, Dunfield which were randomly generated by the program SnapPy  [2].

Crossings @ DunfieldsKnots[[998]]

Here we compute the first coefficient of the Homflypt polynomial for a knot with 1000 crossings in under a minute

Timing @ HomflyptUpTo[DunfieldsKnots[[998]],0]

Crossings @ DunfieldsKnots[[98]]

Here we compute the first two coefficients of the Homflypt polynomial for a knot with 100 crossings in a little over a minute

Timing @ HomflyptUpTo[DunfieldsKnots[[98]],2]

Sources

[1]	Przytycki, J. (2017). The first coefficient of Homflypt and Kauffman polynomials: Vertigan proof of polynomial complexity using dynamic programming. 
	Contemporary Mathematics Knots, Links, Spatial Graphs, and Algebraic Invariants, 1-6. doi:10.1090/conm/689/13860
	
[2]	M. Culler, N. M. Dunfield, M. Goerner, and J. R. Weeks, SnapPy, a computer program for studying the geometry and topology of 3-manifolds, 
	http://snappy.computop.org