The Jones Polynomial: Difference between revisions

From Knot Atlas
Jump to navigationJump to search
No edit summary
No edit summary
Line 6: Line 6:
<!--Robot Land, no human edits to "END"-->
<!--Robot Land, no human edits to "END"-->
{{HelpLine|
{{HelpLine|
n = 1 |
n = 2 |
in = <nowiki>Jones</nowiki> |
in = <nowiki>Jones</nowiki> |
out= <nowiki>Jones[L][q] computes the Jones polynomial of a knot or link L as a function of the variable q.</nowiki>}}
out= <nowiki>Jones[L][q] computes the Jones polynomial of a knot or link L as a function of the variable q.</nowiki>}}
Line 16: Line 16:
<!--Robot Land, no human edits to "END"-->
<!--Robot Land, no human edits to "END"-->
{{InOut|
{{InOut|
n = 2 |
n = 3 |
in = <nowiki>Jones[Knot[6, 1]][q]</nowiki> |
in = <nowiki>Jones[Knot[6, 1]][q]</nowiki> |
out= <nowiki> -4 -3 -2 2 2
out= <nowiki> -4 -3 -2 2 2
Line 26: Line 26:
<!--Robot Land, no human edits to "END"-->
<!--Robot Land, no human edits to "END"-->
{{InOut|
{{InOut|
n = 3 |
n = 4 |
in = <nowiki>Jones[Knot[9, 46]][q]</nowiki> |
in = <nowiki>Jones[Knot[9, 46]][q]</nowiki> |
out= <nowiki> -6 -5 -4 2 -2 1
out= <nowiki> -6 -5 -4 2 -2 1
Line 39: Line 39:


<!--$$Jones[Link[5, Alternating, 1][q]$$-->
<!--$$Jones[Link[5, Alternating, 1][q]$$-->
<!--Robot Land, no human edits to "END"-->
{{InOut|
n = 5 |
in = <nowiki>Jones[Link[5, Alternating, 1][q]</nowiki> |
out= <nowiki>$Failed</nowiki>}}
<!--END-->
<!--END-->


<!--$$PowerExpand[Jones[Link[5, Alternating, 1][t^2]]$$-->
<!--$$PowerExpand[Jones[Link[5, Alternating, 1][t^2]]$$-->
<!--Robot Land, no human edits to "END"-->
{{InOut|
n = 6 |
in = <nowiki>PowerExpand[Jones[Link[5, Alternating, 1][t^2]]</nowiki> |
out= <nowiki>$Failed</nowiki>}}
<!--END-->
<!--END-->


Line 49: Line 59:
<!--Robot Land, no human edits to "END"-->
<!--Robot Land, no human edits to "END"-->
{{In|
{{In|
n = 4 |
n = 7 |
in = <nowiki>all = Join[AllKnots[], AllLinks[]];</nowiki>}}
in = <nowiki>all = Join[AllKnots[], AllLinks[]];</nowiki>}}
<!--END-->
<!--END-->
Line 56: Line 66:
<!--Robot Land, no human edits to "END"-->
<!--Robot Land, no human edits to "END"-->
{{InOut|
{{InOut|
n = 5 |
n = 8 |
in = <nowiki>Length /@ {Union[Jones[#][q]& /@ all], all}</nowiki> |
in = <nowiki>Length /@ {Union[Jones[#][q]& /@ all], all}</nowiki> |
out= <nowiki>{2110, 2226}</nowiki>}}
out= <nowiki>{2110, 2226}</nowiki>}}
Line 87: Line 97:
<!--Robot Land, no human edits to "END"-->
<!--Robot Land, no human edits to "END"-->
{{InOut|
{{InOut|
n = 6 |
n = 9 |
in = <nowiki>L = PD[Knot[3, 1]]</nowiki> |
in = <nowiki>L = PD[Knot[3, 1]]</nowiki> |
out= <nowiki>PD[X[1, 4, 2, 5], X[3, 6, 4, 1], X[5, 2, 6, 3]]</nowiki>}}
out= <nowiki>PD[X[1, 4, 2, 5], X[3, 6, 4, 1], X[5, 2, 6, 3]]</nowiki>}}
Line 99: Line 109:
<!--Robot Land, no human edits to "END"-->
<!--Robot Land, no human edits to "END"-->
{{InOut|
{{InOut|
n = 7 |
n = 10 |
in = <nowiki>t1 = L /. X[a_,b_,c_,d_] :> A P[a,d] P[b,c] + B P[a,b] P[c,d]</nowiki> |
in = <nowiki>t1 = L /. X[a_,b_,c_,d_] :> A P[a,d] P[b,c] + B P[a,b] P[c,d]</nowiki> |
out= <nowiki>PD[A P[1, 5] P[2, 4] + B P[1, 4] P[2, 5],
out= <nowiki>PD[A P[1, 5] P[2, 4] + B P[1, 4] P[2, 5],
Line 111: Line 121:
<!--Robot Land, no human edits to "END"-->
<!--Robot Land, no human edits to "END"-->
{{InOut|
{{InOut|
n = 8 |
n = 11 |
in = <nowiki>t2 = Expand[Times @@ t1]</nowiki> |
in = <nowiki>t2 = Expand[Times @@ t1]</nowiki> |
out= <nowiki> 2
out= <nowiki> 2
Line 143: Line 153:
<!--Robot Land, no human edits to "END"-->
<!--Robot Land, no human edits to "END"-->
{{InOut|
{{InOut|
n = 9 |
n = 12 |
in = <nowiki>t3 = t2 //. {P[a_,b_]P[b_,c_] :> P[a,c], P[a_,b_]^2 :> P[a,a]}</nowiki> |
in = <nowiki>t3 = t2 //. {P[a_,b_]P[b_,c_] :> P[a,c], P[a_,b_]^2 :> P[a,a]}</nowiki> |
out= <nowiki> 3 2
out= <nowiki> 3 2
Line 160: Line 170:
<!--Robot Land, no human edits to "END"-->
<!--Robot Land, no human edits to "END"-->
{{InOut|
{{InOut|
n = 10 |
n = 13 |
in = <nowiki>t4 = Expand[t3 /. P[a_,a_] -> -A^2-B^2 /. B -> 1/A]</nowiki> |
in = <nowiki>t4 = Expand[t3 /. P[a_,a_] -> -A^2-B^2 /. B -> 1/A]</nowiki> |
out= <nowiki> -9 1 3 7
out= <nowiki> -9 1 3 7
Line 174: Line 184:
<!--Robot Land, no human edits to "END"-->
<!--Robot Land, no human edits to "END"-->
{{In|
{{In|
n = 11 |
n = 14 |
in = <nowiki>KB0[pd_] := Expand[
in = <nowiki>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]]
Expand[Times @@ pd /. X[a_,b_,c_,d_] :> A P[a,d] P[b,c] + 1/A P[a,b] P[c,d]]
Line 183: Line 193:
<!--Robot Land, no human edits to "END"-->
<!--Robot Land, no human edits to "END"-->
{{InOut|
{{InOut|
n = 12 |
n = 15 |
in = <nowiki>t4 = KB0[PD[Knot[3, 1]]]</nowiki> |
in = <nowiki>t4 = KB0[PD[Knot[3, 1]]]</nowiki> |
out= <nowiki> -9 1 3 7
out= <nowiki> -9 1 3 7
Line 195: Line 205:
<!--Robot Land, no human edits to "END"-->
<!--Robot Land, no human edits to "END"-->
{{InOut|
{{InOut|
n = 13 |
n = 16 |
in = <nowiki>(-A^3)^(-3) * t4 / (-A^2-1/A^2) /. A -> q^(1/4) // Simplify // Expand</nowiki> |
in = <nowiki>(-A^3)^(-3) * t4 / (-A^2-1/A^2) /. A -> q^(1/4) // Simplify // Expand</nowiki> |
out= <nowiki> -4 -3 1
out= <nowiki> -4 -3 1
Line 209: Line 219:
<!--Robot Land, no human edits to "END"-->
<!--Robot Land, no human edits to "END"-->
{{InOut|
{{InOut|
n = 14 |
n = 17 |
in = <nowiki>time0 = Timing[KB0[PD[Link[11, Alternating, 548]]]]</nowiki> |
in = <nowiki>time0 = Timing[KB0[PD[Link[11, Alternating, 548]]]]</nowiki> |
out= <nowiki> -23 5 10 -3 5 13 17
out= <nowiki> -23 5 10 -3 5 13 17
{2.293 Second, A + --- + -- + A + 6 A + 6 A + 5 A - 5 A +
{1.578 Second, A + --- + -- + A + 6 A + 6 A + 5 A - 5 A +
15 7
15 7
A A
A A
Line 236: Line 246:
<!--Robot Land, no human edits to "END"-->
<!--Robot Land, no human edits to "END"-->
{{In|
{{In|
n = 15 |
n = 18 |
in = <nowiki>KB1[pd_PD] := KB1[pd, {}, 1];
in = <nowiki>KB1[pd_PD] := KB1[pd, {}, 1];
KB1[pd_PD, inside_, web_] := Module[
KB1[pd_PD, inside_, web_] := Module[
Line 254: Line 264:
<!--Robot Land, no human edits to "END"-->
<!--Robot Land, no human edits to "END"-->
{{InOut|
{{InOut|
n = 16 |
n = 19 |
in = <nowiki>time1 = Timing[KB1[PD[Link[11, Alternating, 548]]]]</nowiki> |
in = <nowiki>time1 = Timing[KB1[PD[Link[11, Alternating, 548]]]]</nowiki> |
out= <nowiki> -23 5 10 -3 5 13 17
out= <nowiki> -23 5 10 -3 5 13 17
{0.04 Second, A + --- + -- + A + 6 A + 6 A + 5 A - 5 A +
{0.015 Second, A + --- + -- + A + 6 A + 6 A + 5 A - 5 A +
15 7
15 7
A A
A A
21 25
21 25
Line 265: Line 275:
<!--END-->
<!--END-->


(So on [[L11a548]] <code>KB1</code> is <!--$time0[[1,1]]$--><!--Robot Land, no human edits to "END"-->2.293<!--END-->/<!--$time1[[1,1]]$--><!--Robot Land, no human edits to "END"-->0.04<!--END--> ~ <!--$Round[time0[[1,1]]/time1[[1,1]]]$--><!--Robot Land, no human edits to "END"-->57<!--END--> times faster than <code>KB0</code>.)
(So on [[L11a548]] <code>KB1</code> is <!--$time0[[1,1]]$--><!--Robot Land, no human edits to "END"-->1.578<!--END-->/<!--$time1[[1,1]]$--><!--Robot Land, no human edits to "END"-->0.015<!--END--> ~ <!--$Round[time0[[1,1]]/time1[[1,1]]]$--><!--Robot Land, no human edits to "END"-->105<!--END--> times faster than <code>KB0</code>.)


The idea here is to maintain a "computation front", a planar domain
The idea here is to maintain a "computation front", a planar domain

Revision as of 18:33, 18 September 2005


(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
L5a1.gif
L5a1

On links with an even number of components the Jones polynomial is a function of , and hence it is often more convenient to view it as a function of , where :

In[5]:= Jones[Link[5, Alternating, 1][q]
Out[5]= $Failed
In[6]:= PowerExpand[Jones[Link[5, Alternating, 1][t^2]]
Out[6]= $Failed

The Jones polynomial attains 2110 values on the 2226 knots and links known to KnotTheory`:

In[7]:= all = Join[AllKnots[], AllLinks[]];
In[8]:= Length /@ {Union[Jones[#][q]& /@ all], all}
Out[8]= {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 :

[KBDef]
Failed to parse (unknown function "\slashoverback"): {\displaystyle \langle\emptyset\rangle=1; \qquad \langle\bigcirc L\rangle = (-A^2-B^2)\langle L\rangle; \qquad \langle\slashoverback\rangle = A\langle\hsmoothing\rangle + B\langle\smoothing\rangle; }

here is a commutative variable, , and is the writhe of , the difference where and count the positive Failed to parse (unknown function "\overcrossing"): {\displaystyle (\overcrossing)} and negative Failed to parse (unknown function "\undercrossing"): {\displaystyle (\undercrossing)} crossings of respectively.

PD[X[1,4,2,5], X[3,6,4,1], X[5,2,6,3]] and P[1,4] P[1,5] P[2,4] P[2,6] P[3,5] P[3,6]

Just for concreteness, let us start by fixing to be the trefoil knot shown above:

In[9]:= L = PD[Knot[3, 1]]
Out[9]= PD[X[1, 4, 2, 5], X[3, 6, 4, 1], X[5, 2, 6, 3]]

Our first task is to perform the replacement Failed to parse (unknown function "\slashoverback"): {\displaystyle \langle\slashoverback\rangle\to A\langle\hsmoothing\rangle + B\langle\smoothing\rangle} on all crossings of . By our conventions (see Planar Diagrams) the edges around a crossing are labeled , , and : Failed to parse (SVG (MathML can be enabled via browser plugin): Invalid response ("Math extension cannot connect to Restbase.") from server "https://wikimedia.org/api/rest_v1/":): {\displaystyle {}^c_d\slashoverback{}_a^b} . Labeling the smoothings Failed to parse (unknown function "\hsmoothing"): {\displaystyle (\hsmoothing, \ \smoothing)} in the same way, Failed to parse (SVG (MathML can be enabled via browser plugin): Invalid response ("Math extension cannot connect to Restbase.") from server "https://wikimedia.org/api/rest_v1/":): {\displaystyle {}^c_d\hsmoothing{}_a^b} and Failed to parse (unknown function "\smoothing"): {\displaystyle {}^c_d\smoothing{}_a^b} , we are lead to the symbolic replacement rule . Let us apply this rule to , switch to a multiplicative notation and expand:

In[10]:= t1 = L /. X[a_,b_,c_,d_] :> A P[a,d] P[b,c] + B P[a,b] P[c,d]
Out[10]= 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[11]:= t2 = Expand[Times @@ t1]
Out[11]= 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 the right half of the figure above). We simplify such paths by repeatedly applying the rules and :

In[12]:= t3 = t2 //. {P[a_,b_]P[b_,c_] :> P[a,c], P[a_,b_]^2 :> P[a,a]}
Out[12]= 3 2 B P[1, 1] P[2, 2] P[3, 3] + A B P[2, 2] P[4, 4] + 3 2 2 A P[3, 3] P[4, 4] + A B P[3, 3] P[4, 4] + 3 A B P[5, 5] + 2 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[13]:= t4 = Expand[t3 /. P[a_,a_] -> -A^2-B^2 /. B -> 1/A]
Out[13]= -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[14]:= 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[15]:= t4 = KB0[PD[Knot[3, 1]]]
Out[15]= -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[16]:= (-A^3)^(-3) * t4 / (-A^2-1/A^2) /. A -> q^(1/4) // Simplify // Expand
Out[16]= -4 -3 1 -q + q + - q
L11a548.gif
L11a548

At merely 3 lines of code, our program is surely nice and elegant. But it is very slow:

In[17]:= time0 = Timing[KB0[PD[Link[11, Alternating, 548]]]]
Out[17]= -23 5 10 -3 5 13 17 {1.578 Second, A + --- + -- + A + 6 A + 6 A + 5 A - 5 A + 15 7 A A 21 25 4 A - A }

Here's the much faster alternative employed by KnotTheory`:

In[18]:= 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[19]:= time1 = Timing[KB1[PD[Link[11, Alternating, 548]]]]
Out[19]= -23 5 10 -3 5 13 17 {0.015 Second, A + --- + -- + A + 6 A + 6 A + 5 A - 5 A + 15 7 A A 21 25 4 A - A }

(So on L11a548 KB1 is 1.578/0.015 ~ 105 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 [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 [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 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 [KBDef]. Finally, when pd is empty, the output is simply the value of web.

[Kauffman] ^  L. H. Kauffman, On knots, Princeton Univ. Press, Princeton, 1987.