CableLink.m

2025-08-05T22:55:08Z

Sam.panitch:

2025-08-05T21:29:05Z

Sam.panitch:

CableLink.m

2025-08-05T21:28:47Z

Sam.panitch:

(*

The program <code>CableLink</code> is documented on the page [[Threading a link by a polynomial]]. It is not part of the package <code>KnotTheory`</code> but is designed to work with it. Use <code><nowiki>Import["http://katlas.org/w/index.php?title=CableLink.m&action=raw"]</nowiki></code> to download into a mathematica session, or copy-paste the text below ignoring the <code>*)</code> on the first line and the <code>(*</code> on the last.
<pre>
*)
(*Kauffman bracket*)
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]
(*determine position of a strand label at a crossing*)
strandAtCrossing[crossing_, s_] := Module[{pos},
pos = Position[crossing, s];
If[Length[pos] > 0, pos[[1, 1]], False]
];
(*determine orientation of overstrand. Complicated by components with only 2 labels*)
orientationOfOverStrand[crossing_, link_] := Module[{otherCrossings},
(*find the other crossings containing the strand labels of the overstrand crossing*)
otherCrossings =
DeleteElements[
Select[link,
ContainsAny[
List[Delete[#, 0]], {crossing[[2]],
crossing[[4]]}] &], {crossing}];
(*if the length of othercrossings is 1,
then the overstrand labels are part of a component with only two \
strand labels*)
If[Length[otherCrossings] == 1,
(*first check if a strand label is in the first position of the \
other crossing.*)
Which[otherCrossings[[1, 1]] == crossing[[2]],
True,
otherCrossings[[1, 1]] == crossing[[4]],
False,
(*Otherwise, the strands are always overcrossings,
in which case we just choose to orient from small to large*)
True,
crossing[[2]] > crossing[[4]]
],
(*otherwise,
the overcrossing is oriented from 4 to 2 if pos 2 is 1 more than \
pos 4, or if pos 4 is more than 1 greater than pos 2.*)
crossing[[2]] - crossing[[4]] == 1 ||
crossing[[4]] - crossing[[2]] > 1
]
];
(*find crossing where a strand label enters*)
findEnteringVertex[link_, s_] :=
Module[{crossingsContainingS, firstCrossing, pos},
(*find crossings containing s*)
crossingsContainingS =
Select[link, IntegerQ[strandAtCrossing[#, s]] &];
firstCrossing = crossingsContainingS[[1]];
pos = strandAtCrossing[firstCrossing, s];
Which[
(*if pos is 1, then it is definitely an incoming strand*)
pos == 1,
firstCrossing,
(pos == 2 && !
orientationOfOverStrand[firstCrossing, link]) || (pos == 4 &&
orientationOfOverStrand[firstCrossing, link]),
firstCrossing,
(*otherwise it must be the entering strand at the other vertex \
containing that label*)
True,
crossingsContainingS[[2]]
]
];
increaseStrandLabels[link_, s_] :=
Replace[link, n_?(# > s &) -> n + 1, {2}];
decreaseStrandLabels[link_, s_] :=
Replace[link, n_?(# > s &) -> n - 1, {2}];
(*duplicate a crossing*)
duplicateVertex[link_, crossing_, strands_] :=
Module[{pos = strandAtCrossing[crossing, strands[[1]]],
newLabel = Length[link]*2 + 2,
newLink = DeleteElements[link, {crossing}], p1 = crossing[[1]],
p2 = crossing[[2]], p3 = crossing[[3]], p4 = crossing[[4]]},
Which[
(*pos is 1 and the upper strand is oriented from 4 to 2*)
pos == 1 && orientationOfOverStrand[crossing, link],
{Union[
increaseStrandLabels[newLink, p4],
PD[
X[If[p1 < p2, p1, p1 + 1], p4 + 1, If[p3 < p2, p3, p3 + 1],
p4]],
PD[X[newLabel, If[p2 > p4, p2 + 1, p2], newLabel + 1, p4 + 1]]
],
Map[If[# <= p2, #, # + 1] &, Prepend[strands[[2 ;;]], p3]]
},
(*pos is 1 and the upper strand is oriented from 2 to 4*)
pos == 1,
{Union[
increaseStrandLabels[newLink, p2],
PD[
X[If[p1 < p2, p1, p1 + 1], p2 + 1, If[p3 < p2, p3, p3 + 1],
If[p4 < p2, p4, p4 + 1]]],
PD[X[newLabel, p2, newLabel + 1, p2 + 1]]
],
Map[If[# <= p2, #, # + 1] &, Prepend[strands[[2 ;;]], p3]]
},
(*pos is 2*)
pos == 2,
{Union[
increaseStrandLabels[newLink, p1],
PD[
X[p1, If[p2 < p1, p2, p2 + 1], p1 + 1,
If[p4 < p1, p4, p4 + 1]]],
PD[X[p1 + 1, newLabel, If[p3 < p1, p3, p3 + 1], newLabel + 1]]
],
Map[If[# <= p1, #, # + 1] &, Prepend[strands[[2 ;;]], p4]]
},
(*pos is 4*)
True,
{Union[
increaseStrandLabels[newLink, p1],
PD[
X[p1 + 1, If[p2 < p1, p2, p2 + 1], If[p3 < p1, p3, p3 + 1],
If[p4 < p1, p4, p4 + 1]]],
PD[X[p1, newLabel + 1, p1 + 1, newLabel]]
],
Map[If[# <= p1, #, # + 1] &, Prepend[strands[[2 ;;]], p2]]
}
]
];
(*delete a crossing*)
deleteVertex[link_, crossing_, s_, strandList_] :=
Module[{newCrossing = crossing,
newLink = DeleteElements[link, {crossing}], min, max,
pos = strandAtCrossing[crossing, s], outgoingStrandPos,
newStrandList = strandList},
(*we create an unknot if the two labels of the other strand at the \
crossing are equal*)
Which[(pos == 1 && crossing[[2]] == crossing[[4]]) ,
newStrandList =
Replace[newStrandList,
crossing[[2]] -> 0, {1}], (pos == 2 || pos == 4 ) &&
crossing[[1]] == crossing[[3]],
newStrandList = Replace[newStrandList, crossing[[1]] -> 0, {1}]];
(*"
we need to keep track of the outgoing strand label. There's actually \
two ways to know we're done:
either the outgoing strand is the same as the incoming strand, or \
the whole vertex only involves 2 different labels.
"*)
outgoingStrandPos = Which[pos == 1, 3, pos == 2, 4, True, 2];
If[crossing[[outgoingStrandPos]] == s ||
CountDistinct[{Delete[crossing, 0]}] < 3,
outgoingStrandPos = -1];
(*adjust link after combining pos 1 and pos 3*)
If[crossing[[1]] > crossing[[3]],
newLink =
decreaseStrandLabels[
Replace[newLink, crossing[[1]] -> crossing[[3]], {2}],
newCrossing[[1]]];
newCrossing =
decreaseStrandLabels[{Replace[newCrossing,
crossing[[1]] -> crossing[[3]], {1}]},
newCrossing[[1]]][[1]];
newStrandList =
Map[If[# > newCrossing[[1]], # - 1, #] &,
Replace[newStrandList, crossing[[1]] -> crossing[[3]], {1}]]
,
newLink = decreaseStrandLabels[newLink, newCrossing[[1]]];
newCrossing =
decreaseStrandLabels[{newCrossing}, newCrossing[[1]]][[1]];
newStrandList =
Map[If[# > newCrossing[[1]], # - 1, #] &, newStrandList]
];
(*adjust link after combining pos 2 and pos 4*)
min = Min[newCrossing[[2]], newCrossing[[4]]];
max = Max[newCrossing[[2]], newCrossing[[4]]];
If[max - min > 1,
newLink =
decreaseStrandLabels[Replace[newLink, max -> min, {2}], max];
newCrossing =
decreaseStrandLabels[{Replace[newCrossing, max -> min, {1}]},
max][[1]];
newStrandList =
Map[If[# > max, # - 1, #] &,
Replace[newStrandList, max -> min, {1}]],
newLink = decreaseStrandLabels[newLink, min];
newCrossing = decreaseStrandLabels[{newCrossing}, min][[1]];
newStrandList = Map[If[# > max, # - 1, #] &, newStrandList]
];
{newLink,
If[outgoingStrandPos > 0, newCrossing[[outgoingStrandPos]], -1],
newStrandList}
]
cableComponent[link_, s_, strandList_] :=
Module[{initialStrands, newComponentLabel = 2 Length[link] + 1},
initialStrands = Join[{s, s, newComponentLabel}, strandList];
recurse[newLink_, strands_] :=
Module[{currentStrand = strands[[1]], firstStrand = strands[[2]],
currentCrossing, updatedLink,
updatedStrands},(*copy the current crossing*)
currentCrossing = findEnteringVertex[newLink, currentStrand];
{updatedLink, updatedStrands} =
duplicateVertex[newLink, currentCrossing, strands];
(*check if we've returned to the first strand*)
If[updatedStrands[[1]] == updatedStrands[[2]],
(*replace the largest strand label with the first strand label \
of the new component*)
{Replace[updatedLink,
n_?(# == 2 Length[updatedLink] + 1 &) ->
updatedStrands[[3]], {2}],
updatedStrands[[4 ;;]]},(*keep adding crossings*)
recurse[updatedLink, updatedStrands]]
];
recurse[link, initialStrands]
];
deleteComponent[link_, s_, strandList_] :=
Module[{newLink, currentStrand, newStrandList, currentCrossing},
If[s <= 0,
(*we're done deleting stuff*)
{link, strandList},
(*keep deleting*)
currentCrossing = findEnteringVertex[link, s];
{newLink, currentStrand, newStrandList} =
deleteVertex[link, currentCrossing, s, strandList];
deleteComponent[newLink, currentStrand, newStrandList]
]
];
cableLinkMonomial[link_, strandList_, degreeList_] :=
Module[{newLink = link, newStrandList, newDegreeList, coeff = 1},
(*reorder so that we're deleting components first*)
{newDegreeList, newStrandList} = {degreeList, strandList}[[All,
Ordering@degreeList]];
(*start cabling*)
Do[
Which[
newStrandList[[i]] == 0,
(*it's an unknot*)
coeff = coeff*(-A^2 - A^(-2))^newDegreeList[[i]],
newDegreeList[[i]] == 0,
(*we need to delete it*)
{newLink, newStrandList} =
deleteComponent[newLink, newStrandList[[i]], newStrandList],
True,
(*cable the component*)
Do[
{newLink, newStrandList} =
cableComponent[newLink, newStrandList[[i]], newStrandList]
, {j, 1, newDegreeList[[i]] - 1}]
]
, {i, 1, Length[newStrandList]}
];
coeff*KB1[newLink]
];
CableLink[link_, poly_, strandList_, vars_] :=
Module[{monomials = CoefficientRules[poly, vars], temp},
Total[
Map[
#[[2]]*cableLinkMonomial[link, strandList, #[[1]]] &
, monomials]]
]

Threading a link by a polynomial

2025-08-05T21:28:15Z

Sam.panitch:

CableLink.m

2025-08-05T21:23:44Z

Sam.panitch: Created page with "(* The program <code>CableLink</code> is documented on the page Threading a link by a polynomial. It is not part of the package <code>KnotTheory`</code> but is designed to work with it. Use <code><nowiki>Import["http://katlas.org/w/index.php?title=CableLink.m&action=raw"]</nowiki></code> to download into a mathematica session, or copy-paste the text below ignoring the <code>*)</code> on the first line and the <code>(*</code> on the last. <pre> *) (*Kauffman..."

(*

The program <code>CableLink</code> is documented on the page [[Threading a link by a polynomial]]. It is not part of the package <code>KnotTheory`</code> but is designed to work with it. Use <code><nowiki>Import["http://katlas.org/w/index.php?title=CableLink.m&action=raw"]</nowiki></code> to download into a mathematica session, or copy-paste the text below ignoring the <code>*)</code> on the first line and the <code>(*</code> on the last.
<pre>
*)
(*Kauffman bracket*)
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]
(*determine position of a strand label at a crossing*)
strandAtCrossing[crossing_, s_] := Module[{pos},
pos = Position[crossing, s];
If[Length[pos] > 0, pos[[1, 1]], False]
];
(*determine orientation of overstrand. Complicated by components with only 2 labels*)
orientationOfOverStrand[crossing_, link_] := Module[{otherCrossings},
(*find the other crossings containing the strand labels of the overstrand crossing*)
otherCrossings =
DeleteElements[
Select[link,
ContainsAny[
List[Delete[#, 0]], {crossing[[2]],
crossing[[4]]}] &], {crossing}];
(*if the length of othercrossings is 1,
then the overstrand labels are part of a component with only two \
strand labels*)
If[Length[otherCrossings] == 1,
(*first check if a strand label is in the first position of the \
other crossing.*)
Which[otherCrossings[[1, 1]] == crossing[[2]],
True,
otherCrossings[[1, 1]] == crossing[[4]],
False,
(*Otherwise, the strands are always overcrossings,
in which case we just choose to orient from small to large*)
True,
crossing[[2]] > crossing[[4]]
],
(*otherwise,
the overcrossing is oriented from 4 to 2 if pos 2 is 1 more than \
pos 4, or if pos 4 is more than 1 greater than pos 2.*)
crossing[[2]] - crossing[[4]] == 1 ||
crossing[[4]] - crossing[[2]] > 1
]
];
(*find crossing where a strand label enters*)
findEnteringVertex[link_, s_] :=
Module[{crossingsContainingS, firstCrossing, pos},
(*find crossings containing s*)
crossingsContainingS =
Select[link, IntegerQ[strandAtCrossing[#, s]] &];
firstCrossing = crossingsContainingS[[1]];
pos = strandAtCrossing[firstCrossing, s];
Which[
(*if pos is 1, then it is definitely an incoming strand*)
pos == 1,
firstCrossing,
(pos == 2 && !
orientationOfOverStrand[firstCrossing, link]) || (pos == 4 &&
orientationOfOverStrand[firstCrossing, link]),
firstCrossing,
(*otherwise it must be the entering strand at the other vertex \
containing that label*)
True,
crossingsContainingS[[2]]
]
];
increaseStrandLabels[link_, s_] :=
Replace[link, n_?(# > s &) -> n + 1, {2}];
decreaseStrandLabels[link_, s_] :=
Replace[link, n_?(# > s &) -> n - 1, {2}];
(*duplicate a crossing*)
duplicateVertex[link_, crossing_, strands_] :=
Module[{pos = strandAtCrossing[crossing, strands[[1]]],
newLabel = Length[link]*2 + 2,
newLink = DeleteElements[link, {crossing}], p1 = crossing[[1]],
p2 = crossing[[2]], p3 = crossing[[3]], p4 = crossing[[4]]},
Which[
(*pos is 1 and the upper strand is oriented from 4 to 2*)
pos == 1 && orientationOfOverStrand[crossing, link],
{Union[
increaseStrandLabels[newLink, p4],
PD[
X[If[p1 < p2, p1, p1 + 1], p4 + 1, If[p3 < p2, p3, p3 + 1],
p4]],
PD[X[newLabel, If[p2 > p4, p2 + 1, p2], newLabel + 1, p4 + 1]]
],
Map[If[# <= p2, #, # + 1] &, Prepend[strands[[2 ;;]], p3]]
},
(*pos is 1 and the upper strand is oriented from 2 to 4*)
pos == 1,
{Union[
increaseStrandLabels[newLink, p2],
PD[
X[If[p1 < p2, p1, p1 + 1], p2 + 1, If[p3 < p2, p3, p3 + 1],
If[p4 < p2, p4, p4 + 1]]],
PD[X[newLabel, p2, newLabel + 1, p2 + 1]]
],
Map[If[# <= p2, #, # + 1] &, Prepend[strands[[2 ;;]], p3]]
},
(*pos is 2*)
pos == 2,
{Union[
increaseStrandLabels[newLink, p1],
PD[
X[p1, If[p2 < p1, p2, p2 + 1], p1 + 1,
If[p4 < p1, p4, p4 + 1]]],
PD[X[p1 + 1, newLabel, If[p3 < p1, p3, p3 + 1], newLabel + 1]]
],
Map[If[# <= p1, #, # + 1] &, Prepend[strands[[2 ;;]], p4]]
},
(*pos is 4*)
True,
{Union[
increaseStrandLabels[newLink, p1],
PD[
X[p1 + 1, If[p2 < p1, p2, p2 + 1], If[p3 < p1, p3, p3 + 1],
If[p4 < p1, p4, p4 + 1]]],
PD[X[p1, newLabel + 1, p1 + 1, newLabel]]
],
Map[If[# <= p1, #, # + 1] &, Prepend[strands[[2 ;;]], p2]]
}
]
];
(*delete a crossing*)
deleteVertex[link_, crossing_, s_, strandList_] :=
Module[{newCrossing = crossing,
newLink = DeleteElements[link, {crossing}], min, max,
pos = strandAtCrossing[crossing, s], outgoingStrandPos,
newStrandList = strandList},
(*we create an unknot if the two labels of the other strand at the \
crossing are equal*)
Which[(pos == 1 && crossing[[2]] == crossing[[4]]) ,
newStrandList =
Replace[newStrandList,
crossing[[2]] -> 0, {1}], (pos == 2 || pos == 4 ) &&
crossing[[1]] == crossing[[3]],
newStrandList = Replace[newStrandList, crossing[[1]] -> 0, {1}]];
(*"
we need to keep track of the outgoing strand label. There's actually \
two ways to know we're done:
either the outgoing strand is the same as the incoming strand, or \
the whole vertex only involves 2 different labels.
"*)
outgoingStrandPos = Which[pos == 1, 3, pos == 2, 4, True, 2];
If[crossing[[outgoingStrandPos]] == s ||
CountDistinct[{Delete[crossing, 0]}] < 3,
outgoingStrandPos = -1];
(*adjust link after combining pos 1 and pos 3*)
If[crossing[[1]] > crossing[[3]],
newLink =
decreaseStrandLabels[
Replace[newLink, crossing[[1]] -> crossing[[3]], {2}],
newCrossing[[1]]];
newCrossing =
decreaseStrandLabels[{Replace[newCrossing,
crossing[[1]] -> crossing[[3]], {1}]},
newCrossing[[1]]][[1]];
newStrandList =
Map[If[# > newCrossing[[1]], # - 1, #] &,
Replace[newStrandList, crossing[[1]] -> crossing[[3]], {1}]]
,
newLink = decreaseStrandLabels[newLink, newCrossing[[1]]];
newCrossing =
decreaseStrandLabels[{newCrossing}, newCrossing[[1]]][[1]];
newStrandList =
Map[If[# > newCrossing[[1]], # - 1, #] &, newStrandList]
];
(*adjust link after combining pos 2 and pos 4*)
min = Min[newCrossing[[2]], newCrossing[[4]]];
max = Max[newCrossing[[2]], newCrossing[[4]]];
If[max - min > 1,
newLink =
decreaseStrandLabels[Replace[newLink, max -> min, {2}], max];
newCrossing =
decreaseStrandLabels[{Replace[newCrossing, max -> min, {1}]},
max][[1]];
newStrandList =
Map[If[# > max, # - 1, #] &,
Replace[newStrandList, max -> min, {1}]],
newLink = decreaseStrandLabels[newLink, min];
newCrossing = decreaseStrandLabels[{newCrossing}, min][[1]];
newStrandList = Map[If[# > max, # - 1, #] &, newStrandList]
];
{newLink,
If[outgoingStrandPos > 0, newCrossing[[outgoingStrandPos]], -1],
newStrandList}
]
cableComponent[link_, s_, strandList_] :=
Module[{initialStrands, newComponentLabel = 2 Length[link] + 1},
initialStrands = Join[{s, s, newComponentLabel}, strandList];
recurse[newLink_, strands_] :=
Module[{currentStrand = strands[[1]], firstStrand = strands[[2]],
currentCrossing, updatedLink,
updatedStrands},(*copy the current crossing*)
currentCrossing = findEnteringVertex[newLink, currentStrand];
{updatedLink, updatedStrands} =
duplicateVertex[newLink, currentCrossing, strands];
(*check if we've returned to the first strand*)
If[updatedStrands[[1]] == updatedStrands[[2]],
(*replace the largest strand label with the first strand label \
of the new component*)
{Replace[updatedLink,
n_?(# == 2 Length[updatedLink] + 1 &) ->
updatedStrands[[3]], {2}],
updatedStrands[[4 ;;]]},(*keep adding crossings*)
recurse[updatedLink, updatedStrands]]
];
recurse[link, initialStrands]
];
deleteComponent[link_, s_, strandList_] :=
Module[{newLink, currentStrand, newStrandList, currentCrossing},
If[s <= 0,
(*we're done deleting stuff*)
{link, strandList},
(*keep deleting*)
currentCrossing = findEnteringVertex[link, s];
{newLink, currentStrand, newStrandList} =
deleteVertex[link, currentCrossing, s, strandList];
deleteComponent[newLink, currentStrand, newStrandList]
]
];
cableLinkMonomial[link_, strandList_, degreeList_] :=
Module[{newLink = link, newStrandList, newDegreeList, coeff = 1},
(*reorder so that we're deleting components first*)
{newDegreeList, newStrandList} = {degreeList, strandList}[[All,
Ordering@degreeList]];
(*start cabling*)
Do[
Which[
newStrandList[[i]] == 0,
(*it's an unknot*)
coeff = coeff*(-A^2 - A^(-2))^newDegreeList[[i]],
newDegreeList[[i]] == 0,
(*we need to delete it*)
{newLink, newStrandList} =
deleteComponent[newLink, newStrandList[[i]], newStrandList],
True,
(*cable the component*)
Do[
{newLink, newStrandList} =
cableComponent[newLink, newStrandList[[i]], newStrandList]
, {j, 1, newDegreeList[[i]] - 1}]
]
, {i, 1, Length[newStrandList]}
];
coeff*KB1[newLink]
];
cableLink[link_, poly_, strandList_, vars_] :=
Module[{monomials = CoefficientRules[poly, vars], temp},
Total[
Map[
#[[2]]*cableLinkMonomial[link, strandList, #[[1]]] &
, monomials]]
]

Template:Manual TOC Sidebar2

2025-08-05T21:15:22Z

Sam.panitch:

<noinclude>[[Image:Stop_hand.png]] Warning! Any changes you make here should also be reflected in the [[Printable Manual]]! Please remember to go there and make the appropriate changes.</noinclude>
{| cellpadding="0" cellspacing="0" width=240 style="clear: right; float: right"
|- align=left
|<div class="NavFrame"><div class="NavHead">[[KnotTheory`]]/[[Template:Manual TOC Sidebar2|Navigation]] </div>
<div class="NavContent" style="text-align: left">
[[The Mathematica Package KnotTheory`]]
* [[Acknowledgement]]
* [[Setup]]
* [[Naming and Enumeration]]
* [[Presentations]]
** [[Planar Diagrams]]
*** [[Planar Diagrams#Some further details|Some further details]]
** [[Gauss Codes]]
** [[DT (Dowker-Thistlethwaite) Codes]]
** [[Braid Representatives]]
** [[MorseLink Presentations]]
** [[Arc Presentations]]
** [[Conway Notation]]
* [[Graphical Input]]
* [[Graphical Output]]
** [[Drawing Planar Diagrams]]
*** [[Drawing Planar Diagrams#How does it work?|How does it work?]]
** [[Drawing MorseLink Presentations]]
** [[Drawing Braids]]
* [[Structure and Operations]]
* [[Invariants]]
** [[Invariants from Braid Theory]]
** [[Three Dimensional Invariants]]
** [[The Alexander-Conway Polynomial]]
** [[The Multivariable Alexander Polynomial]]
** [[The Determinant and the Signature]]
** [[The Jones Polynomial]]
*** [[The Jones Polynomial#How is the Jones polynomial computed?|How is the Jones polynomial computed?]]
** [[The Coloured Jones Polynomials]]
** [[The A2 Invariant]]
** [[Quantum knot invariants]]
** [[The HOMFLY-PT Polynomial]]
** [[The Kauffman Polynomial]]
** [[Finite Type (Vassiliev) Invariants]]
** [[Khovanov Homology]]
** [[Heegaard Floer Knot Homology]]
** [[R-Matrix Invariants]]
* [[Extras Included with KnotTheory`]]
** [[Drawing with TubePlot]]
*** [[Drawing with TubePlot#Standalone TubePlot|Standalone_TubePlot]]
** [[Using the LinKnot package]]
** [[WikiLink]]
** [[QuantumGroups`]]
* [[Lightly Documented Features]]
* [[A Sample KnotTheory` Session]]
* [[Further Usage Example]]
** [[Prime Links with a Non-Prime Component]]
** [["Rubberband" Brunnian Links]]
** [[Identifying Knots within a List]]
** [[Cabling]]
** [[Burau's Theorem]]
** [[Threading a link by a polynomial]]
* [[Further Knot Theory Software]]
** [[Further Knot Theory Software#KnotPlot|KnotPlot]]
** [[Further Knot Theory Software#Knotscape|Knotscape]]
** [[Further Knot Theory Software#Xknots|Xknots]]
* [[Extending/Modifying KnotTheory`|Extending/Modifying <code>KnotTheory`</code>]]
* [[Bugs]]
* [[How to Edit this Manual...]]
</div></div>
|}

Threading a link by a polynomial

2025-08-05T21:13:00Z

Sam.panitch: Created page with "<code>cableLink[link,poly,strandList,vars]</code>, whose code is available here, computes the Kauffman bracket of link (given as a PD) with components L1,L2,...,Ln, cabled by the polynomial poly in the variables z1,z2,...,zn. strandList is a list of strand labels of length n, where the ith element is the first strand label corresponding to component Li. As an example, we can verify some formulas from Mausbaum: <!--$$Import["http://katlas.org/w/index.php?t..."

<code>cableLink[link,poly,strandList,vars]</code>, whose code is available [[cableLink.m|here]], computes the Kauffman bracket of link (given as a PD) with components L1,L2,...,Ln, cabled by the polynomial poly in the variables z1,z2,...,zn. strandList is a list of strand labels of length n, where the ith element is the first strand label corresponding to component Li.
As an example, we can verify some formulas from Mausbaum:

Printable Manual

2025-08-05T21:12:02Z

Sam.panitch:

__NOEDITSECTION__

[[Image:KnotTheory 240.gif|frame|[[Setup|Download / Setup]]]]

This manual describes the [http://www.wolfram.com/ Mathematica] package KnotTheory`, the main tool used to produce The Knot Atlas.

Return to the wiki [[The Mathematica Package KnotTheory`|manual]].

==Acknowledgement==
{{:Acknowledgement}}
==Setup==
{{:Setup}}
==Naming and Enumeration==
{{:Naming and Enumeration}}
==Presentations==
{{:Presentations}}
===Planar Diagrams===
{{:Planar Diagrams}}
===Gauss Codes===
{{:Gauss Codes}}
===DT (Dowker-Thistlethwaite) Codes===
{{:DT (Dowker-Thistlethwaite) Codes}}
===Braid Representatives===
{{:Braid Representatives}}
===MorseLink Presentations===
{{:MorseLink Presentations}}
===Arc Presentations===
{{:Arc Presentations}}
===Conway Notation===
{{:Conway Notation}}
==Graphical Input==
{{:Graphical Input}}
==Graphical Output==
{{:Graphical Output}}
===Drawing Planar Diagrams===
{{:Drawing Planar Diagrams}}
===Drawing MorseLink Presentations===
{{:Drawing MorseLink Presentations}}
===Drawing Braids===
{{:Drawing Braids}}
==Structure and Operations==
{{:Structure and Operations}}
==Invariants==
{{:Invariants}}
===Invariants from Braid Theory===
{{:Invariants from Braid Theory}}
===Three Dimensional Invariants===
{{:Three Dimensional Invariants}}
===The Alexander-Conway Polynomial===
{{:The Alexander-Conway Polynomial}}
===The Multivariable Alexander Polynomial===
{{:The Multivariable Alexander Polynomial}}
===The Determinant and the Signature===
{{:The Determinant and the Signature}}
===The Jones Polynomial===
{{:The Jones Polynomial}}
===The Coloured Jones Polynomials===
{{:The Coloured Jones Polynomials}}
===The A2 Invariant===
{{:The A2 Invariant}}
===Quantum knot invariants===
{{:Quantum knot invariants}}
===The HOMFLY-PT Polynomial===
{{:The HOMFLY-PT Polynomial}}
===The Kauffman Polynomial===
{{:The Kauffman Polynomial}}
===Finite Type (Vassiliev) Invariants===
{{:Finite Type (Vassiliev) Invariants}}
===Khovanov Homology===
{{:Khovanov Homology}}
===Heegaard Floer Knot Homology===
{{:Heegaard Floer Knot Homology}}
===R-Matrix Invariants===
{{:R-Matrix Invariants}}
==Extras Included with KnotTheory`==
{{:Extras Included with KnotTheory`}}
===Drawing with TubePlot===
{{:Drawing with TubePlot}}
===Using the LinKnot package===
{{:Using the LinKnot package}}
===WikiLink===
{{:WikiLink}}
===QuantumGroups`===
{{:QuantumGroups`}}
==Lightly Documented Features==
{{:Lightly Documented Features}}
==A Sample KnotTheory` Session==
{{:A Sample KnotTheory` Session}}
==Further Usage Example==
{{:Further Usage Example}}
===Prime Links with a Non-Prime Component===
{{:Prime Links with a Non-Prime Component}}
==="Rubberband" Brunnian Links===
{{:"Rubberband" Brunnian Links}}
===Identifying Knots within a List===
{{:Identifying Knots within a List}}
===Cabling===
{{:Cabling}}
===Burau's Theorem===
{{:Burau's Theorem}}
===Threading a link by a polynomial===
{{:Threading a link by a polynomial}}
==Further Knot Theory Software==
{{:Further Knot Theory Software}}
==Extending/Modifying <code>KnotTheory`</code>==
{{:Extending/Modifying KnotTheory`}}
==Bugs==
{{:Bugs}}
==How to Edit this Manual...==
{{:How to Edit this Manual...}}