Next: 7.6 The Coloured Jones
Up: 7 Invariants
Previous: 7.4 The Determinant and
  Contents
  Index
Subsections
In[2]:= ?Jones
|
In Section 3 we checked that the knots
and
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} |
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 [Ka1]) the
definition of the Jones polynomial using the Kauffman bracket
:
Just for concreteness, let us start by fixing to be the trefoil
knot (see Figure 6):
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
on all crossings of
. By our conventions (see Section 4.1) the edges
around a crossing
are labeled
,
,
and
:
. Labeling
and
in the same way,
and
, we are lead to the symbolic
replacement rule
. Let us apply
this rule to
, 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[A P[1, 5] P[2, 4] + B P[1, 4] P[2, 5], > B P[1, 4] P[3, 6] + A P[1, 3] P[4, 6], > A P[2, 6] P[3, 5] + B P[2, 5] P[3, 6]] |
In[9]:= | t2 = Expand[Times @@ t1] |
Out[9]= | 2 A B P[1, 4] P[1, 5] P[2, 4] P[2, 6] P[3, 5] P[3, 6] + 2 2 > A B P[1, 4] P[2, 5] P[2, 6] P[3, 5] P[3, 6] + 2 2 > A B P[1, 4] P[1, 5] P[2, 4] P[2, 5] P[3, 6] + 3 2 2 2 > B P[1, 4] P[2, 5] P[3, 6] + 3 > A P[1, 3] P[1, 5] P[2, 4] P[2, 6] P[3, 5] P[4, 6] + 2 > A B P[1, 3] P[1, 4] P[2, 5] P[2, 6] P[3, 5] P[4, 6] + 2 > A B P[1, 3] P[1, 5] P[2, 4] P[2, 5] P[3, 6] P[4, 6] + 2 2 > A B P[1, 3] P[1, 4] P[2, 5] P[3, 6] P[4, 6] |
In the above expression the product P[1,4] P[1,5] P[2,4] P[2,6]
P[3,5] P[3,6] represents a path in which 1 is connected to 4, 1 is connected to 5, 2 is connected to 4,
etc. (see Figure 6). We simplify such paths by
repeatedly applying the rules
and
:
In[10]:= | t3 = t2 //. {P[a_,b_]P[b_,c_] :> P[a,c], P[a_,b_]^2 :> P[a,a]} |
Out[10]= | 3 2 3 B P[1, 1] P[2, 2] P[3, 3] + A B P[2, 2] P[4, 4] + A P[3, 3] P[4, 4] + 2 2 2 > A B P[3, 3] P[4, 4] + 3 A B P[5, 5] + A B P[1, 1] P[5, 5] |
To complete the computation of the Kauffman bracket, all that remains is to
replace closed cycles (paths of the form by
, to replace
by
, 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[ Expand[Times @@ pd /. X[a_,b_,c_,d_] :> A P[a,d] P[b,c] + 1/A P[a,b] P[c,d]] //. {P[a_,b_]P[b_,c_] :> P[a,c], P[a_,b_]^2 :> P[a,a], P[a_,a_] -> -A^2-1/A^2} ] |
In[13]:= | t4 = KB0[PD[Knot[3, 1]]] |
Out[13]= | -9 1 3 7 -A + - + A + A A |
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 the
result is
, and hence the Jones polynomial of
is given by
In[14]:= | (-A^3)^(-3) * t4 / (-A^2-1/A^2) /. A -> q^(1/4) // Simplify // Expand |
Out[14]= | -4 -3 1 -q + q + - q |
![]() |
At merely 3 lines of code, our program is surely nice and elegant. But at 12.59 seconds for an 11 crossing link, it is very slow:
In[15]:= | Timing[KB0[PD[Link[11, Alternating, 548]]]] |
Out[15]= | -23 5 10 -3 5 13 17 21 {12.59 Second, A + --- + -- + A + 6 A + 6 A + 5 A - 5 A + 4 A - 15 7 A A 25 > A } |
Here's the much faster alternative employed by KnotTheory`:
In[16]:= | KB1[pd_PD] := KB1[pd, {}, 1]; KB1[pd_PD, inside_, web_] := Module[ {pos = First[Ordering[Length[Complement[List @@ #, inside]]& /@ pd]]}, pd[[pos]] /. X[a_,b_,c_,d_] :> KB1[ Delete[pd, pos], Union[inside, {a,b,c,d}], Expand[web*(A P[a,d] P[b,c]+1/A P[a,b] P[c,d])] //. { P[e_,f_]P[f_,g_] :> P[e,g], P[e_,_]^2 :> P[e,e], P[e_,e_] -> -A^2-1/A^2 } ] ]; KB1[PD[],_,web_] := Expand[web] |
In[17]:= | Timing[KB1[PD[Link[11, Alternating, 548]]]] |
Out[17]= | -23 5 10 -3 5 13 17 21 {0.14 Second, A + --- + -- + A + 6 A + 6 A + 5 A - 5 A + 4 A - 15 7 A A 25 > A } |
(So on the link L11a548 KB1
is
times
faster than
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 (1), 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 (1) 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 KB1[pd, inside, web]
computes the
Kauffman bracket assuming the labels of the edges inside the front are in
the variable inside, the already-computed inside of the front is in
the variable web and the part of the link diagram yet untouched is
pd. The single argument KB1[pd]
simply calls
KB1[pd, inside, web]
with an empty inside and with web
set to 1. The three argument KB1[pd, inside, web]
finds the position
of the crossing maximmally connected to the front using the somewhat
cryptic assignment
pos = First[Ordering[Length[Complement[List @@ #, inside]]& /@ pd]]}
KB1[pd, inside, web]
then recursively calls
itself with that crossing removed from pd, with its legs
added to the inside, and with web updated in accordance
with (1). Finally, when pd is empty, the output is
simply the value of web.