The Jones Polynomial
(For In[1] see Setup)
In[2]:= ?Jones
Jones[L][q] computes the Jones polynomial of a knot or link L as a function of the variable q. |
In Naming and Enumeration we checked that the knots 6_1 and 9_46 have the same Alexander polynomial. Their Jones polynomials are different, though:
In[3]:= |
Jones[Knot[6, 1]][q] |
Out[3]= | -4 -3 -2 2 2 2 + q - q + q - - - q + q q |
In[4]:= |
Jones[Knot[9, 46]][q] |
Out[4]= | -6 -5 -4 2 -2 1 2 + q - q + q - -- + q - - 3 q q |
The Jones polynomial attains 2110 values on the 2226 knots and links known to KnotTheory`
:
In[5]:= |
all = Join[AllKnots[], AllLinks[]]; |
In[6]:= |
Length /@ {Union[Jones[#][q]& /@ all], all} |
Out[6]= | {2110, 2226} |
How is the Jones polynomial computed?
The Jones polynomial is so simple to compute using Mathematica that it's worthwhile pause and see how this is done, even for readers with limited prior programming experience. First, recall (say from [Kauffman]) the definition of the Jones polynomial using the Kauffman bracket :
here is a commutative variable, , and is the writhe of , the difference where and count the positive () and negative () crossings of respectively.
\index{trefoil} Just for concreteness, let us start by fixing $L$ to be the trefoil knot (see Figure~\ref{fig:PDTrefoil}):
\begin{figure} \htmlimage{} \centering{
\includegraphics[height=3cm]{figs/PDTrefoil.eps}
} \caption{
{\tt PD[X[1,4,2,5], X[3,6,4,1], X[5,2,6,3]]} and {\tt P[1,4] P[1,5] P[2,4] P[2,6] P[3,5] P[3,6]}.
} \label{fig:PDTrefoil} \end{figure}
In[7]:= |
L = PD[Knot[3, 1]] |
Out[7]= | PD[X[1, 4, 2, 5], X[3, 6, 4, 1], X[5, 2, 6, 3]] |
Our first task is to perform the replacement $\la\slashoverback\ra \to A\la\hsmoothing\ra + B\la\smoothing\ra$ on all crossings of $L$. By our conventions (see Section~\ref{subsec:PD}) the edges around a crossing $X_{abcd}$ are labeled $a$, $b$, $c$ and $d$: $\v^c_d\text{\large$\slashoverback$}\v_a^b$. Labeling $\hsmoothing$ and $\smoothing$ in the same way, $\v^c_d\text{\large$\hsmoothing$}\v_a^b$ and $\v^c_d\text{\large$\smoothing$}\v_a^b$, we are lead to the symbolic replacement rule $X_{abcd}\to AP_{ad}P_{bc}+BP_{ab}P_{cd}$. Let us apply this rule to $L$, switch to a multiplicative notation and expand:
In[8]:= |
t1 = L /. X[a_,b_,c_,d_] :> A P[a,d] P[b,c] + B P[a,b] P[c,d] |
Out[8]= | PD[B {6, 10, 16, 12, 4, 18, 20, 22, 2, 8, 14}[1, 4] {6, 10, 16, 12, 4, 18, 20, 22, 2, 8, 14}[2, 5] + A {6, 10, 16, 12, 4, 18, 20, 22, 2, 8, 14}[1, 5] {6, 10, 16, 12, 4, 18, 20, 22, 2, 8, 14}[4, 2], B {6, 10, 16, 12, 4, 18, 20, 22, 2, 8, 14}[3, 6] {6, 10, 16, 12, 4, 18, 20, 22, 2, 8, 14}[4, 1] + A {6, 10, 16, 12, 4, 18, 20, 22, 2, 8, 14}[3, 1] {6, 10, 16, 12, 4, 18, 20, 22, 2, 8, 14}[6, 4], A {6, 10, 16, 12, 4, 18, 20, 22, 2, 8, 14}[2, 6] {6, 10, 16, 12, 4, 18, 20, 22, 2, 8, 14}[5, 3] + B {6, 10, 16, 12, 4, 18, 20, 22, 2, 8, 14}[5, 2] {6, 10, 16, 12, 4, 18, 20, 22, 2, 8, 14}[6, 3]] |
In[9]:= |
t2 = Expand[Times @@ t1] |
Out[9]= | 2 A B {6, 10, 16, 12, 4, 18, 20, 22, 2, 8, 14}[1, 4] {6, 10, 16, 12, 4, 18, 20, 22, 2, 8, 14}[2, 5] {6, 10, 16, 12, 4, 18, 20, 22, 2, 8, 14}[2, 6] {6, 10, 16, 12, 4, 18, 20, 22, 2, 8, 14}[3, 6] {6, 10, 16, 12, 4, 18, 20, 22, 2, 8, 14}[4, 1] {6, 10, 16, 12, 4, 18, 20, 22, 2, 8, 14}[5, 3] 2 + A B {6, 10, 16, 12, 4, 18, 20, 22, 2, 8, 14}[1, 5] {6, 10, 16, 12, 4, 18, 20, 22, 2, 8, 14}[2, 6] {6, 10, 16, 12, 4, 18, 20, 22, 2, 8, 14}[3, 6] {6, 10, 16, 12, 4, 18, 20, 22, 2, 8, 14}[4, 1] {6, 10, 16, 12, 4, 18, 20, 22, 2, 8, 14}[4, 2] {6, 10, 16, 12, 4, 18, 20, 22, 2, 8, 14}[5, 3] 3 + B {6, 10, 16, 12, 4, 18, 20, 22, 2, 8, 14}[1, 4] {6, 10, 16, 12, 4, 18, 20, 22, 2, 8, 14}[2, 5] {6, 10, 16, 12, 4, 18, 20, 22, 2, 8, 14}[3, 6] {6, 10, 16, 12, 4, 18, 20, 22, 2, 8, 14}[4, 1] {6, 10, 16, 12, 4, 18, 20, 22, 2, 8, 14}[5, 2] {6, 10, 16, 12, 4, 18, 20, 22, 2, 8, 14}[6, 3] 2 + A B {6, 10, 16, 12, 4, 18, 20, 22, 2, 8, 14}[1, 5] {6, 10, 16, 12, 4, 18, 20, 22, 2, 8, 14}[3, 6] {6, 10, 16, 12, 4, 18, 20, 22, 2, 8, 14}[4, 1] {6, 10, 16, 12, 4, 18, 20, 22, 2, 8, 14}[4, 2] {6, 10, 16, 12, 4, 18, 20, 22, 2, 8, 14}[5, 2] {6, 10, 16, 12, 4, 18, 20, 22, 2, 8, 14}[6, 3] 2 + A B {6, 10, 16, 12, 4, 18, 20, 22, 2, 8, 14}[1, 4] {6, 10, 16, 12, 4, 18, 20, 22, 2, 8, 14}[2, 5] {6, 10, 16, 12, 4, 18, 20, 22, 2, 8, 14}[2, 6] {6, 10, 16, 12, 4, 18, 20, 22, 2, 8, 14}[3, 1] {6, 10, 16, 12, 4, 18, 20, 22, 2, 8, 14}[5, 3] {6, 10, 16, 12, 4, 18, 20, 22, 2, 8, 14}[6, 4] 3 + A {6, 10, 16, 12, 4, 18, 20, 22, 2, 8, 14}[1, 5] {6, 10, 16, 12, 4, 18, 20, 22, 2, 8, 14}[2, 6] {6, 10, 16, 12, 4, 18, 20, 22, 2, 8, 14}[3, 1] {6, 10, 16, 12, 4, 18, 20, 22, 2, 8, 14}[4, 2] {6, 10, 16, 12, 4, 18, 20, 22, 2, 8, 14}[5, 3] {6, 10, 16, 12, 4, 18, 20, 22, 2, 8, 14}[6, 4] 2 + A B {6, 10, 16, 12, 4, 18, 20, 22, 2, 8, 14}[1, 4] {6, 10, 16, 12, 4, 18, 20, 22, 2, 8, 14}[2, 5] {6, 10, 16, 12, 4, 18, 20, 22, 2, 8, 14}[3, 1] {6, 10, 16, 12, 4, 18, 20, 22, 2, 8, 14}[5, 2] {6, 10, 16, 12, 4, 18, 20, 22, 2, 8, 14}[6, 3] {6, 10, 16, 12, 4, 18, 20, 22, 2, 8, 14}[6, 4] 2 + A B {6, 10, 16, 12, 4, 18, 20, 22, 2, 8, 14}[1, 5] {6, 10, 16, 12, 4, 18, 20, 22, 2, 8, 14}[3, 1] {6, 10, 16, 12, 4, 18, 20, 22, 2, 8, 14}[4, 2] {6, 10, 16, 12, 4, 18, 20, 22, 2, 8, 14}[5, 2] {6, 10, 16, 12, 4, 18, 20, 22, 2, 8, 14}[6, 3] {6, 10, 16, 12, 4, 18, 20, 22, 2, 8, 14}[6, 4] |
In the above expression the product {\tt P[1,4] P[1,5] P[2,4] P[2,6] P[3,5] P[3,6]} represents a path in which {\tt 1} is connected to {\tt 4}, {\tt 1} is connected to {\tt 5}, {\tt 2} is connected to {\tt 4}, etc. (see Figure~\ref{fig:PDTrefoil}). We simplify such paths by repeatedly applying the rules $P_{ab}P_{bc}\to P_{ac}$ and $P^2_{ab}\to P_{aa}$:
In[10]:= |
t3 = t2 //. {P[a_,b_]P[b_,c_] :> P[a,c], P[a_,b_]^2 :> P[a,a]} |
Out[10]= | 2 A B {6, 10, 16, 12, 4, 18, 20, 22, 2, 8, 14}[2, 2] + 2 A B {6, 10, 16, 12, 4, 18, 20, 22, 2, 8, 14}[1, 1] {6, 10, 16, 12, 4, 18, 20, 22, 2, 8, 14}[2, 2] + 3 B {6, 10, 16, 12, 4, 18, 20, 22, 2, 8, 14}[1, 1] {6, 10, 16, 12, 4, 18, 20, 22, 2, 8, 14}[2, 2] {6, 10, 16, 12, 4, 18, 20, 22, 2, 8, 14}[3, 3] 2 + A B {6, 10, 16, 12, 4, 18, 20, 22, 2, 8, 14}[4, 4] + 3 A {6, 10, 16, 12, 4, 18, 20, 22, 2, 8, 14}[3, 3] {6, 10, 16, 12, 4, 18, 20, 22, 2, 8, 14}[4, 4] + 2 A B {6, 10, 16, 12, 4, 18, 20, 22, 2, 8, 14}[3, 3] {6, 10, 16, 12, 4, 18, 20, 22, 2, 8, 14}[4, 4] + 2 A B {6, 10, 16, 12, 4, 18, 20, 22, 2, 8, 14}[6, 6] + 2 A B {6, 10, 16, 12, 4, 18, 20, 22, 2, 8, 14}[2, 2] {6, 10, 16, 12, 4, 18, 20, 22, 2, 8, 14}[6, 6] |
To complete the computation of the Kauffman bracket, all that remains is to replace closed cycles (paths of the form $P_{aa}$ by $-A^2-B^2$, to replace $B$ by $A^{-1}$, and to simplify:
In[11]:= |
t4 = Expand[t3 /. P[a_,a_] -> -A^2-B^2 /. B -> 1/A] |
Out[11]= | -9 1 3 7 -A + - + A + A A |
We could have, of course, combined the above four lines to a single very short program, that compues the Kauffman bracket from the beginning to the end:
In[12]:= |
KB0[pd_] := Expand[\n Expand[Times @@ pd /. X[a_,b_,c_,d_] :> A P[a,d] P[b,c] + 1/A P[a,b] P[c,d]]\n //. {P[a_,b_]P[b_,c_] :> P[a,c], P[a_,b_]^2 :> P[a,a], P[a_,a_] -> -A^2-1/A^2}\n ] |
Out[12]= | $Failed |
In[13]:= |
t4 = KB0[PD[Knot[3, 1]]] |
Out[13]= | KB0[PD[X[1, 4, 2, 5], X[3, 6, 4, 1], X[5, 2, 6, 3]]] |
We will skip the uninteresting code for the computation of the writhe here; it is a linear time computation, and if that's all we ever wanted to compute, we wouldn't have bothered to purchase a computer. For our $L$ the result is $-3$, and hence the Jones polynomial of $L$ is given by
In[14]:= |
(-A^3)^(-3) * t4 / (-A^2-1/A^2) /. A -> q^(1/4) // Simplify // Expand |
Out[14]= | KB0[PD[X[1, 4, 2, 5], X[3, 6, 4, 1], X[5, 2, 6, 3]]] ---------------------------------------------------- 7/4 q (1 + q) |
\begin{figure} \htmlimage{} \centering{
\includegraphics[height=3cm]{figs/L11a548.eps}
} \caption{
The link \hlink{../Links/11a548.html}{L11a548}.
} \end{figure}
%<* InOut@"Timing[KB0[PD[Link[11, Alternating, 548]]]]"; *>
At merely 3 lines of code, our program is surely nice and elegant. But at <* time1=Out[0]1,1 *> seconds for an 11 crossing link, it is very slow:
<* InOut[0] *> \vskip 6pt
Here's the much faster alternative employed by {\tt KnotTheory`}:
In[15]:= |
KB1[pd_PD] := KB1[pd, {}, 1];\n KB1[pd_PD, inside_, web_] := Module[\n {pos = First[Ordering[Length[Complement[List @@ #, inside]]& /@ pd]]},\n pdpos /. X[a_,b_,c_,d_] :> KB1[\n Delete[pd, pos],\n Union[inside, {a,b,c,d}],\n Expand[web*(A P[a,d] P[b,c]+1/A P[a,b] P[c,d])] //. {\n P[e_,f_]P[f_,g_] :> P[e,g], P[e_,_]^2 :> P[e,e], P[e_,e_] -> -A^2-1/A^2\n }\n ]\n ];\n KB1[PD[],_,web_] := Expand[web]" |
Out[15]= | $Failed |
In[16]:= |
Timing[KB1[PD[Link[11, Alternating, 548]]]] |
Out[16]= | {0.172 Second, KB1[PD[X[6, 1, 7, 2], X[2, 5, 3, 6], X[18, 11, 19, 12], X[10, 3, 11, 4], X[4, 9, 1, 10], X[14, 7, 15, 8], X[8, 13, 5, 14], X[22, 20, 17, 19], X[16, 22, 13, 21], X[20, 16, 21, 15], X[12, 17, 9, 18]]]} |
(So on the link \hlink{../Links/11a548.html}{L11a548} \verb"KB1" is $<*time1*>/<*time2=Out[0]1,1*>\sim<*Round[time1/time2]*>$ times faster than \verb"KB0".)
The idea here is to maintain a ``computation front, a planar domain which starts empty and gradualy increases until the whole link diagram is enclosed. Within the front, the rules defining the Kauffman bracket, Equation~\eqref{eq:KBDef}, are applied and the result is expanded as much as possible. Outside of the front the link diagram remains untouched. At every step we choose a crossing outside the front with the most legs inside and ``conquer it --- apply the rules of~\eqref{eq:KBDef} and expand again. As our new outpost is maximally connected to our old territory, the length of the boundary is increased in a minimal way, and hence the size of the ``web within our front remains as small as possible and thus quick to manipulate.
In further detail, the routine \verb"KB1[pd, inside, web]" computes the Kauffman bracket assuming the labels of the edges inside the front are in the variable {\tt inside}, the already-computed inside of the front is in the variable {\tt web} and the part of the link diagram yet untouched is {\tt pd}. The single argument \verb"KB1[pd]" simply calls \verb"KB1[pd, inside, web]" with an empty {\tt inside} and with {\tt web} set to 1. The three argument \verb"KB1[pd, inside, web]" finds the position of the crossing maximmally connected to the front using the somewhat cryptic assignment
\begin{verbatim}
pos = First[Ordering[Length[Complement[List @@ #, inside]]& /@ pd]]}
\end{verbatim}
\noindent \verb"KB1[pd, inside, web]" then recursively calls itself with that crossing removed from {\tt pd}, with its legs added to the {\tt inside}, and with {\tt web} updated in accordance with~\eqref{eq:KBDef}. Finally, when {\tt pd} is empty, the output is simply the value of {\tt web}.
[Kauffman] ^ L. H. Kauffman, On knots, Princeton Univ. Press, Princeton, 1987.