I'm having an issue plotting torus links in Mathematica. What I'm trying to generate is a (2,8) torus link like the one in the picture in Wikipedia: using equations such as those outlined here.

However, I appear to only get half of the respective torus link.

a = 1; d = 4; p = 2; q = 8;
ParametricPlot3D[{(a*Sin[q*t] + d)*Sin[p*t], (a*Sin[q*t] + d)*
Cos[p*t], a*Cos[q*t]}, {t, 0, 2*Pi}, PlotStyle -> Orange,
PlotRange -> All] /. Line[pts_, rest___] :> Tube[pts, 0.2, rest] (a and d are parameters that control the width of the tube and the distance of the curve from the origin respectively, outlined here.)

Can anyone explain why I am only seeing half of the link?

• You're only plotting one set of parametric equations and you can see in the image that you don't expect there to be any intersections so the smooth parametric equations clearly can't generate the structure you want. On the other hand, it ought to be clear that the others may be generated via a simple rotation in the x-y plane. Aug 2, 2018 at 8:09

The second torus is created by a rotation of $$\pi/4$$ (around {0, 0, 1}):

R = RotationMatrix[Pi/4, {0, 0, 1}];
torus = {(a*Sin[q*t] + d)*Sin[p*t], (a*Sin[q*t] + d)*Cos[p*t], a*Cos[q*t]};
ParametricPlot3D[{torus, R.torus} // Evaluate, {t, 0, 2*Pi}, PlotStyle -> {Orange, Blue}, PlotRange -> All] Here's I think a generalization of what Ulrich gave to an arbitrary $(p, q)$ torus (if I read Wikipedia right):

plotPQTorus[{p_, q_}, a : _?NumericQ : 1, d : _?NumericQ : 4,
ops : OptionsPattern[]] :=
Block[{t},
ParametricPlot3D[
Evaluate@
Table[
RotationMatrix[
i*2 \[Pi]/q, {0, 0, 1}].{(a*Sin[q*t] + d)*
Sin[p*t], (a*Sin[q*t] + d)*Cos[p*t], a*Cos[q*t]},
{i, 0, If[Divisible[q, p], p - 1, 0]}
],
{t, 0, 2*Pi},
PlotRange -> All,
ops
] /. Line[pts_, rest___] :> Tube[pts, 0.2, rest]
]


Here are a few plots:

Table[plotPQTorus[{p, Fibonacci[q]}, Boxed -> False,
Axes -> None], {p, 1, 4}, {q, 2, 6, 2}] // Grid Note that relatively prime things are single connected loops (as Wikipedia suggests they should be)

The (1,4) torus knot is known to KnotData[], so we can use that to build the (2,8) knot:

knot14 = First[KnotData[{"TorusKnot", {1, 4}}, "ImageData"]]; 