Identifying Knots within a List: Difference between revisions

From Knot Atlas
Jump to navigationJump to search
No edit summary
No edit summary
 
(5 intermediate revisions by one other user not shown)
Line 1: Line 1:
{{Manual TOC Sidebar}}
{{Manual TOC Sidebar}}


<code>IdentifyWithin[L,H]</code> returns those elements from the list of knots <math>H</math>, whose invariant matches that of the knot <math>L</math>. It can also recognize mirrors and connected sums of the knots in the list. Its options include turning off (on) the search for connected sums with <code>ConnectedSum->False (True)</code> and choosing the invariants to be used in identification by selecting, for example, <code>Invariants->{Jones[#][q]&, HOMFLYPT[#][a,z]&}</code>.
<code>IdentifyWithin[L,H]</code>, whose code is available [[IdentifyWithin.m|here]], returns those elements from the list of knots <math>H</math>, whose invariant matches that of the knot <math>L</math>. It can also recognize mirrors and connected sums of the knots in the list. Its options include turning off (on) the search for connected sums with <code>ConnectedSum->False (True)</code> and choosing the invariants to be used in identification by selecting, for example, <code>Invariants->{Jones[#][q]&, HOMFLYPT[#][a,z]&}</code>.
<code>IdentifyWithin</code> can be used together with [[Prime Links with a Non-Prime Component|<code>SubLink</code>]] to determine the components of a link. For the second component of link [[L11n150]], for instance, we get:
<code>IdentifyWithin</code> can be used together with [[Prime Links with a Non-Prime Component|<code>SubLink</code>]] to determine the components of a link. For the second component of link [[L11n150]], for instance, we get:


{{Startup Note}}
{{Startup Note}}


<!--$$Options[IdentifyWithin] = {
<!--$$Import["http://katlas.org/w/index.php?title=IdentifyWithin.m&action=raw"];$$-->
Invariants -> {Jones[#][q] &, HOMFLYPT[#][a, z] &,
Kauffman[#][a, z] &},
ConnectedSum -> "True"};
IdentifyWithin[L_, H_List, opts___Rule] :=
Module[
{div, j = 1, l, i = 1, u, mu, t, mt, out = {}, out1 = {}, nk, mnk,
mnk1, p, mp, m, p1,
invariants = (Invariants /. {opts} /. Options[IdentifyWithin]),
connectedsum = (ConnectedSum /. {opts} /.
Options[IdentifyWithin])},
NormalizeP[poly_] := Module[{t1, i1},
(For[i1 = 1 ; t1 := FactorList[poly],
i1 <= Length[Variables[poly]], i1++,
t1 =
DeleteCases[t1, {Variables[poly][[i1]], _Integer} | {1, 1}]];
Times @@ Power @@@ t1 )];
l := Length[invariants];
u[0] = mu[0] = H;
While[i <= l && ! Length[out] === 1,
t[i] = invariants[[i]][L];
mt[i] = invariants[[i]][Mirror[L]];
u[i] = Select[u[i - 1], t[i] == invariants[[i]][#] &];
mu[i] = Select[mu[i - 1], mt[i] == invariants[[i]][#] &];
out = Flatten[{u[i], Mirror /@ mu[i]}];
i++];
Which[
Length[out] >= 2, DeleteCases[out, Mirror[Knot[0, 1]]],
Length[out] == 1,
out = If[u[i - 1] != {}, u[i - 1], Mirror /@ mu[i - 1]],
connectedsum === "True", i = 1; nk[0] = mnk[0] = H;
While[Length[out1] != 1 && i <= l,
p[i] = NormalizeP[t[i]];
mp[i] = NormalizeP[mt[i]];
nk[i] =
Select[nk[i - 1], (p1 = NormalizeP[invariants[[i]][#]]; z = 3;
PolynomialRemainder[p[i], p1, Variables[p[i]][[1]]] ===
0 ) &];
mnk[i] =
Select[mnk[i - 1], (p1 = NormalizeP[invariants[[i]][#]]; z = 3;
PolynomialRemainder[mp[i], p1, Variables[p[i]][[1]]] ===
0 ) &];
Clear[z];
mnk1[i] = Mirror /@ mnk[i];
div = Flatten[{nk[i], mnk1[i]}];
div = DeleteCases[div, Knot[0, 1] | Mirror[Knot[0, 1]]];
If[div == {}, out1 = {},
For[m = 1;
W[0] =
CS[0] = Select[
Flatten /@ Flatten[Outer[List, div, div, 1], 1], OrderedQ],
Length[W[m - 1][[1]]] < 4, m++,
W[m] = Select[
Flatten /@ Flatten[Outer[List, div, W[m - 1], 1], 1],
OrderedQ];
CS[m] = Flatten[{CS[m - 1], W[m]}, 1];
];
out1 =
Select[CS[m - 1],
Expand[Times @@ invariants[[i]] /@ #] == t[i] &];
];
i++];
If[out1 == {}, {}, ConnectedSum @@@ out1], True, {}
]
];$$-->
<!--Robot Land, no human edits to "END"-->
<!--Robot Land, no human edits to "END"-->
{{In|
{{In|
n = 3 |
n = 2 |
in = <nowiki>Options[IdentifyWithin] = {
in = <nowiki>Import["http://katlas.org/w/index.php?title=IdentifyWithin.m&action=raw"];</nowiki>}}
Invariants -> {Jones[#][q] &, HOMFLYPT[#][a, z] &,
Kauffman[#][a, z] &},
ConnectedSum -> "True"};
IdentifyWithin[L_, H_List, opts___Rule] :=
Module[
{div, j = 1, l, i = 1, u, mu, t, mt, out = {}, out1 = {}, nk, mnk,
mnk1, p, mp, m, p1,
invariants = (Invariants /. {opts} /. Options[IdentifyWithin]),
connectedsum = (ConnectedSum /. {opts} /.
Options[IdentifyWithin])},
NormalizeP[poly_] := Module[{t1, i1},
(For[i1 = 1 ; t1 := FactorList[poly],
i1 <= Length[Variables[poly]], i1++,
t1 =
DeleteCases[t1, {Variables[poly][[i1]], _Integer} &#124; {1, 1}]];
Times @@ Power @@@ t1 )];
l := Length[invariants];
u[0] = mu[0] = H;
While[i <= l && ! Length[out] === 1,
t[i] = invariants[[i]][L];
mt[i] = invariants[[i]][Mirror[L]];
u[i] = Select[u[i - 1], t[i] == invariants[[i]][#] &];
mu[i] = Select[mu[i - 1], mt[i] == invariants[[i]][#] &];
out = Flatten[{u[i], Mirror /@ mu[i]}];
i++];
Which[
Length[out] >= 2, DeleteCases[out, Mirror[Knot[0, 1]]],
Length[out] == 1,
out = If[u[i - 1] != {}, u[i - 1], Mirror /@ mu[i - 1]],
connectedsum === "True", i = 1; nk[0] = mnk[0] = H;
While[Length[out1] != 1 && i <= l,
p[i] = NormalizeP[t[i]];
mp[i] = NormalizeP[mt[i]];
nk[i] =
Select[nk[i - 1], (p1 = NormalizeP[invariants[[i]][#]]; z = 3;
PolynomialRemainder[p[i], p1, Variables[p[i]][[1]]] ===
0 ) &];
mnk[i] =
Select[mnk[i - 1], (p1 = NormalizeP[invariants[[i]][#]]; z = 3;
PolynomialRemainder[mp[i], p1, Variables[p[i]][[1]]] ===
0 ) &];
Clear[z];
mnk1[i] = Mirror /@ mnk[i];
div = Flatten[{nk[i], mnk1[i]}];
div = DeleteCases[div, Knot[0, 1] &#124; Mirror[Knot[0, 1]]];
If[div == {}, out1 = {},
For[m = 1;
W[0] =
CS[0] = Select[
Flatten /@ Flatten[Outer[List, div, div, 1], 1], OrderedQ],
Length[W[m - 1][[1]]] < 4, m++,
W[m] = Select[
Flatten /@ Flatten[Outer[List, div, W[m - 1], 1], 1],
OrderedQ];
CS[m] = Flatten[{CS[m - 1], W[m]}, 1];
];
out1 =
Select[CS[m - 1],
Expand[Times @@ invariants[[i]] /@ #] == t[i] &];
];
i++];
If[out1 == {}, {}, ConnectedSum @@@ out1], True, {}
]
];</nowiki>}}
<!--END-->
<!--END-->


<!--$$Import["http://katlas.org/w/index.php?title=SubLink.m&action=raw"];$$-->
<!--$$SubLink[pd_PD, js_List] := Module[
<!--Robot Land, no human edits to "END"-->
{k, t0, t, t1, t2, S, P},
{{In|
t0 = Flatten[List @@@ Skeleton[pd][[js]]];
n = 3 |
t = pd /. x_X :> Select[x, MemberQ[t0, #] &];
in = <nowiki>Import["http://katlas.org/w/index.php?title=SubLink.m&action=raw"];</nowiki>}}
t = DeleteCases[t, X[]];
<!--END-->
k = 1;
While[
k <= Length[t],
If[ Length[t[[k]]] < 4,
t = Delete[t, k] /. (Rule @@ t[[k]]), ++k];
];
t1 = List @@ Union @@ t;
t2 = Thread[(t1) -> Range[Length[t1]]];
S = t /. t2;
P = If[S != PD[] && Length[S] >= 3, S, PD[Knot[0, 1]], S]
];
SubLink[pd_PD, j_] := SubLink[pd, {j}];
SubLink[L_, js_] := SubLink[PD[L], js];$$-->



<!--$$IdentifyWithin[SubLink[Link["L11n150"], 2], AllKnots[]]$$-->
<!--$$IdentifyWithin[SubLink[Link["L11n150"], 2], AllKnots[]]$$-->
<!--Robot Land, no human edits to "END"-->
<!--Robot Land, no human edits to "END"-->
{{InOut|
{{InOut|
n = 2 |
n = 4 |
in = <nowiki>IdentifyWithin[SubLink[Link["L11n150"], 2], AllKnots[]]</nowiki> |
in = <nowiki>IdentifyWithin[SubLink[Link["L11n150"], 2], AllKnots[]]</nowiki> |
out= <nowiki>{Knot[5, 2]}</nowiki>}}
out= <nowiki>{Knot[5, 2]}</nowiki>}}
<!--END-->
<!--END-->



{{Knot Image Pair|L11n150|gif|5_2|gif}}
{{Knot Image Pair|L11n150|gif|5_2|gif}}



Unfortunately, the program does not provide absolute identification when all the used invariants cannot distinguish between two or more different knots. In that case, a list of possible candidates for <math>L</math> is returned.
Unfortunately, the program does not provide absolute identification when all the used invariants cannot distinguish between two or more different knots. In that case, a list of possible candidates for <math>L</math> is returned.

Latest revision as of 15:04, 20 October 2013


KnotTheory`/Navigation 

The Mathematica Package KnotTheory`

IdentifyWithin[L,H], whose code is available here, returns those elements from the list of knots , whose invariant matches that of the knot . It can also recognize mirrors and connected sums of the knots in the list. Its options include turning off (on) the search for connected sums with ConnectedSum->False (True) and choosing the invariants to be used in identification by selecting, for example, Invariants->{Jones[#][q]&, HOMFLYPT[#][a,z]&}. IdentifyWithin can be used together with SubLink to determine the components of a link. For the second component of link L11n150, for instance, we get:

(For In[1] see Setup)

In[2]:= Import["http://katlas.org/w/index.php?title=IdentifyWithin.m&action=raw"];
In[3]:= Import["http://katlas.org/w/index.php?title=SubLink.m&action=raw"];
In[4]:= IdentifyWithin[SubLink[Link["L11n150"], 2], AllKnots[]]
Out[4]= {Knot[5, 2]}
L11n150.gif
L11n150 		5 2.gif
5_2

Unfortunately, the program does not provide absolute identification when all the used invariants cannot distinguish between two or more different knots. In that case, a list of possible candidates for is returned.

Retrieved from "https://katlas.org/index.php?title=Identifying_Knots_within_a_List&oldid=1720989"