IdentifyWithin.m - Revision history

Drorbn at 18:54, 20 October 2013

2013-10-20T18:54:31Z

← Older revision		Revision as of 14:54, 20 October 2013
Line 1:		Line 1:
	(*		(*

	The program <code>IdentifyWithin</code>, documented in the page on [[Identifying Knots within a List]]. It is not part of the package <code>KnotTheory`</code> but is designed to work with it. Use <code><nowiki>Import["http://katlas.org/~~wiki~~/IdentifyWithin.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.		The program <code>IdentifyWithin</code>, documented in the page on [[Identifying Knots within a List]]. 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=IdentifyWithin.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>		<pre>
	*)		*)

Drorbn at 15:55, 28 December 2009

2009-12-28T15:55:38Z

← Older revision		Revision as of 11:55, 28 December 2009
Line 5:		Line 5:
	*)		*)
	Options[IdentifyWithin] = {		Options[IdentifyWithin] = {
	~~Invariants~~ -> {Jones[#][q] &, HOMFLYPT[#][a, z] &,		UseInvariants -> {Jones[#][q] &, HOMFLYPT[#][a, z] &,
	Kauffman[#][a, z] &},		Kauffman[#][a, z] &},
	ConnectedSum -> "True"};		ConnectedSum -> "True"};
Line 13:		Line 13:
	{div, j = 1, l, i = 1, u, mu, t, mt, out = {}, out1 = {}, nk, mnk,		{div, j = 1, l, i = 1, u, mu, t, mt, out = {}, out1 = {}, nk, mnk,
	mnk1, p, mp, m, p1,		mnk1, p, mp, m, p1,
	invariants = (~~Invariants~~ /. {opts} /. Options[IdentifyWithin]),		invariants = (UseInvariants /. {opts} /. Options[IdentifyWithin]),
	connectedsum = (ConnectedSum /. {opts} /.		connectedsum = (ConnectedSum /. {opts} /.
	Options[IdentifyWithin])},		Options[IdentifyWithin])},

IvaH: New page: (* The program `IdentifyWithin`, documented in the page on Identifying Knots within a List. It is not part of the package KnotTheory` but is designed to work w...

2007-11-18T23:23:43Z

New page: (* The program <code>IdentifyWithin</code>, documented in the page on Identifying Knots within a List. It is not part of the package <code>KnotTheory`</code> but is designed to work w...

New page

(*

The program <code>IdentifyWithin</code>, documented in the page on [[Identifying Knots within a List]]. It is not part of the package <code>KnotTheory`</code> but is designed to work with it. Use <code><nowiki>Import["http://katlas.org/wiki/IdentifyWithin.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>
*)
Options[IdentifyWithin] = {
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, {}
]
];
(* </pre> *)

IdentifyWithin.m - Revision history

Drorbn at 18:54, 20 October 2013

Drorbn at 15:55, 28 December 2009

IvaH: New page: (* The program IdentifyWithin, documented in the page on Identifying Knots within a List. It is not part of the package KnotTheory` but is designed to work w...

IvaH: New page: (* The program `IdentifyWithin`, documented in the page on Identifying Knots within a List. It is not part of the package KnotTheory` but is designed to work w...