SubLink.m

(*

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/wiki/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[pd_PD, js_List] := Module[
  {k, t0, t, t1, t2, S, P},
  t0 = Flatten[List @@@ Skeleton[pd][[js]]];
  t = pd /. x_X :> Select[x, MemberQ[t0, #] &];
  t = DeleteCases[t, X[]];
  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];
(* 

*)