CableLink.m - Revision history

Sam.panitch at 23:03, 5 August 2025

2025-08-05T23:03:21Z

← Older revision		Revision as of 19:03, 5 August 2025
Line 254:		Line 254:
	coeff*KB1[newLink]		coeff*KB1[newLink]
	];		];
	~~cableLink~~[link_, poly_, strandList_, vars_] :=		CableLink[link_, poly_, strandList_, vars_] :=
	Module[{monomials = CoefficientRules[poly, vars], temp},		Module[{monomials = CoefficientRules[poly, vars], temp},
	Total[		Total[

Sam.panitch at 22:59, 5 August 2025

2025-08-05T22:59:13Z

← Older revision		Revision as of 18:59, 5 August 2025
Line 1:		Line 1:
		⚫	(*

	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. Copy-paste the text below ignoring the <code>)</code> on the first line and the <code>(</code> on the last.		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. Copy-paste the text below ignoring the <code>)</code> on the first line and the <code>(</code> on the last.
	<pre>		<pre>
Line 262:		Line 262:
	]		]

			(* </pre> *)
⚫	(*

Sam.panitch at 22:58, 5 August 2025

2025-08-05T22:58:27Z

← Older revision		Revision as of 18:58, 5 August 2025
Line 9:		Line 9:
	Module[{pos =		Module[{pos =
	First[Ordering[Length[Complement[List @@ #, inside]] & /@ pd]]},		First[Ordering[Length[Complement[List @@ #, inside]] & /@ pd]]},
	pd~~<code>~~[[pos]]~~<code>~~ /.		pd[[pos]] /.
	X[a_, b_, c_, d_] :>		X[a_, b_, c_, d_] :>
	KB1[Delete[pd, pos], Union[inside, {a, b, c, d}],		KB1[Delete[pd, pos], Union[inside, {a, b, c, d}],

Sam.panitch at 22:58, 5 August 2025

2025-08-05T22:58:12Z

← Older revision		Revision as of 18:58, 5 August 2025
Line 9:		Line 9:
	Module[{pos =		Module[{pos =
	First[Ordering[Length[Complement[List @@ #, inside]] & /@ pd]]},		First[Ordering[Length[Complement[List @@ #, inside]] & /@ pd]]},
	pd\[\[pos\]\] /.		pd<code>[[pos]]<code> /.
	X[a_, b_, c_, d_] :>		X[a_, b_, c_, d_] :>
	KB1[Delete[pd, pos], Union[inside, {a, b, c, d}],		KB1[Delete[pd, pos], Union[inside, {a, b, c, d}],

Sam.panitch at 22:56, 5 August 2025

2025-08-05T22:56:57Z

← Older revision		Revision as of 18:56, 5 August 2025
Line 9:		Line 9:
	Module[{pos =		Module[{pos =
	First[Ordering[Length[Complement[List @@ #, inside]] & /@ pd]]},		First[Ordering[Length[Complement[List @@ #, inside]] & /@ pd]]},
	pd[[pos]] /.		pd\[\[pos\]\] /.
	X[a_, b_, c_, d_] :>		X[a_, b_, c_, d_] :>
	KB1[Delete[pd, pos], Union[inside, {a, b, c, d}],		KB1[Delete[pd, pos], Union[inside, {a, b, c, d}],

Sam.panitch at 22:55, 5 August 2025

2025-08-05T22:55:24Z

← Older revision		Revision as of 18:55, 5 August 2025
Line 262:		Line 262:
	]		]

	*(		(*

Sam.panitch at 22:55, 5 August 2025

2025-08-05T22:55:08Z

← Older revision		Revision as of 18:55, 5 August 2025
Line 261:		Line 261:
	, monomials]]		, monomials]]
	]		]

			*(

Sam.panitch at 22:52, 5 August 2025

2025-08-05T22:52:47Z

← Older revision		Revision as of 18:52, 5 August 2025
Line 16:		Line 16:
	P[e_, e_] -> -A^2 - 1/A^2}]];		P[e_, e_] -> -A^2 - 1/A^2}]];
	KB1[PD[], _, web_] := Expand[web]		KB1[PD[], _, web_] := Expand[web]
	(~~determine position~~ of a strand ~~label~~ at a crossing)		(Position of a strand at a crossing)
	strandAtCrossing[crossing_, s_] := Module[{pos},		strandAtCrossing[crossing_, s_] := Module[{pos},
	pos = Position[crossing, s];		pos = Position[crossing, s];
	If[Length[pos] > 0, pos[[1, 1]], False]		If[Length[pos] > 0, pos[[1, 1]], False]
	];		];
	(~~determine orientation~~ of overstrand. Complicated by components with only 2 labels)		(Orientation of overstrand. Complicated by components with only two strand labels)
	orientationOfOverStrand[crossing_, link_] := Module[{otherCrossings},		orientationOfOverStrand[crossing_, link_] := Module[{otherCrossings},
	(find the other crossings containing the strand labels of the ~~overstrand crossing)~~		(*find the other crossings containing the strand labels of the \
		⚫	overstrand crossing*)
	otherCrossings =		otherCrossings =
	DeleteElements[		DeleteElements[
Line 52:		Line 53:
	]		]
	];		];
	(~~find~~ crossing ~~where~~ a strand ~~label~~ enters)		(crossing that a strand enters)
	findEnteringVertex[link_, s_] :=		findEnteringVertex[link_, s_] :=
	Module[{crossingsContainingS, firstCrossing, pos},		Module[{crossingsContainingS, firstCrossing, pos},
Line 74:		Line 75:
	]		]
	];		];
⚫	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_] :=		duplicateVertex[link_, crossing_, strands_] :=
	Module[{pos = strandAtCrossing[crossing, strands[[1]]],		Module[{pos = strandAtCrossing[crossing, strands[[1]]],
Line 131:		Line 127:
	]		]
	];		];
⚫	~~(delete a~~ crossing)
	deleteVertex[link_, crossing_, s_, strandList_] :=		deleteVertex[link_, crossing_, s_, strandList_] :=
	Module[{newCrossing = crossing,		Module[{newCrossing = crossing,
Line 163:		Line 158:
	newCrossing =		newCrossing =
	decreaseStrandLabels[{Replace[newCrossing,		decreaseStrandLabels[{Replace[newCrossing,
	crossing[[1]] -> crossing[[3]], {1}]},		crossing[[1]] -> crossing[[3]], {1}]}, newCrossing[[1]]][[
	~~newCrossing[[1]]][[~~1]];		1]];
	newStrandList =		newStrandList =
	Map[If[# > newCrossing[[1]], # - 1, #] &,		Map[If[# > newCrossing[[1]], # - 1, #] &,
Line 195:		Line 190:
	newStrandList}		newStrandList}
	]		]
		⚫	increaseStrandLabels[link_, s_] :=
		⚫	Replace[link, n_?(# > s &) -> n + 1, {2}];
		⚫	decreaseStrandLabels[link_, s_] :=
		⚫	Replace[link, n_?(# > s &) -> n - 1, {2}];
	cableComponent[link_, s_, strandList_] :=		cableComponent[link_, s_, strandList_] :=
	Module[{initialStrands, newComponentLabel = 2 Length[link] + 1},		Module[{initialStrands, newComponentLabel = 2 Length[link] + 1},
Line 255:		Line 254:
	coeff*KB1[newLink]		coeff*KB1[newLink]
	];		];
	~~CableLink~~[link_, poly_, strandList_, vars_] :=		cableLink[link_, poly_, strandList_, vars_] :=
	Module[{monomials = CoefficientRules[poly, vars], temp},		Module[{monomials = CoefficientRules[poly, vars], temp},
	Total[		Total[

Sam.panitch at 22:34, 5 August 2025

2025-08-05T22:34:33Z

← Older revision		Revision as of 18:34, 5 August 2025
Line 1:		Line 1:
	(*

	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. Copy-paste the text below ignoring the <code>)</code> on the first line and the <code>(</code> on the last.		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. Copy-paste the text below ignoring the <code>)</code> on the first line and the <code>(</code> on the last.
	<pre>		<pre>
	*)		*)

	*)
	(Kauffman bracket)		(Kauffman bracket)
	KB1[pd_PD] := KB1[pd, {}, 1];		KB1[pd_PD] := KB1[pd, {}, 1];

Sam.panitch at 22:34, 5 August 2025

2025-08-05T22:34:17Z

← Older revision		Revision as of 18:34, 5 August 2025
Line 3:		Line 3:
	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. Copy-paste the text below ignoring the <code>)</code> on the first line and the <code>(</code> on the last.		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. Copy-paste the text below ignoring the <code>)</code> on the first line and the <code>(</code> on the last.
	<pre>		<pre>
			*)
	*)		*)
	(Kauffman bracket)		(Kauffman bracket)