(*

The program `SubLink`, documented in the page on Prime Links with a Non-Prime Component. It is not part of the package `KnotTheory`` but is designed to work with it. Use `Import["http://katlas.org/w/index.php?title=SubLink.m&action=raw"]` to download into a mathematica session, or copy-paste the text below ignoring the `*)` on the first line and the `(*` on the last.

```*)
sublink of pd made out of the components of pd in the list js.";
{k, t0, t, t1, t2, s0, s1},
s0 = Skeleton[pd];
(* t0 contains the list of edges that should appear in the sublink *)
t0 = Flatten[List @@@ s0[[js]]];
(* t is pd with all edges not in t0 removed;
this means that some crossings will now involve just 0 or 2 edges. *)
t = pd /. x_X :> Select[x, MemberQ[t0, #] &];
(* Remove all "empty" crossings from t: *)
t = DeleteCases[t, X[] | Loop[]];
(* Remove all "valency 2" crossings from t,while also removing not-
longer-necessary edge labels: *)
k = 1;
While[
k <= Length[t],
If[Length[t[[k]]] == 2,
t = Delete[t, k] /. (Rule @@ t[[k]]),
(* else *) ++k
];
];
(* We have to manually "re-add" all skeleton components that "disappeared": *)
s1 = Union[Flatten[List @@ List @@@ t]];
Do[
If[
MemberQ[js, k] && (And @@ (FreeQ[s1, #] & /@ s0[[k]])),
AppendTo[t, Loop[s0[[k, 1]]]];
AppendTo[s1, s0[[k, 1]]]
],
{k, Length[s0]}
];
(* t1 will have all edge-labels still appearing in t;
it is used to relabel t so that the edge labels will be consecutive *)
t1 = Sort[s1];