Pensieve header: Debugging the "SubLink" program, with Iva Halacheva.

<< KnotTheory`

SubLink::usage = "SubLink[pd, js] returns the sublink of pd made out of the components of pd in the list js.";
SubLink[pd_PD,js_List] := Module[
{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];
t2=Thread[(t1)->Range[Length[t1]]];
t/.t2
];
SubLink[pd_PD,j_]:=SubLink[pd,{j}];
SubLink[L_,js_]:=SubLink[PD[L],js];

?SubLink

Ls = Link /@ {"L7a7", "L10a149"}

DrawMorseLink /@ Ls

SubLink[#, {1,2}]& /@ Ls

Length[Ls=Select[AllLinks[{2,11}], Length[Skeleton[#]]==3&]]

PD[NewLink[1]] = PD[X[1,23,2,22],X[3,24,4,17],X[4,12,5,11],X[6,13,7,14],X[9,3,10,2],X[12,20,13,19],X[14,21,15,22],X[15,8,16,1],X[17,11,18,10],X[18,5,19,6],X[20,8,21,7],X[23,16,24,9]];
AppendTo[Ls, NewLink[1]];

trivials={-(1/(Sqrt[q]))-(Sqrt[q]), 1, -(1/(q^2))-(1/q), -q-q^2}

Bs=Select[Ls, And[
MemberQ[trivials, Jones[SubLink[#, {1,2}]][q]],
MemberQ[trivials, Jones[SubLink[#, {2,3}]][q]],
MemberQ[trivials, Jones[SubLink[#, {3,1}]][q]]
]&]

trivialAs={0};
Select[Ls, And[
MemberQ[trivialAs, MultivariableAlexander[SubLink[#, {1,2}]][t]],
MemberQ[trivialAs, MultivariableAlexander[SubLink[#, {2,3}]][t]],
MemberQ[trivialAs, MultivariableAlexander[SubLink[#, {3,1}]][t]]
]&]

MultivariableAlexander[PD[Loop[1]]]

MultivariableAlexander[PD[Loop[1], Loop[2]]]

MultivariableAlexander[
Append[PD[Knot[3,1]], Loop[7]]
]