Drawing a torus not bounding a solid torus

Question

I am trying to make a "pretty" picture of a torus in $\mathbb{R}^3$ which does not bound a solid torus. The standard way of constructing such a thing is to first take a non-trivial torus knot:

f[t_, s_] := {(2 + Cos[s]) Cos[t], (2 + Cos[s]) Sin[t], Sin[s]} - 
             {2,0, 0}
 ParametricPlot3D[f[t, 3 t/2], {t, 0, 4 Pi}]

This is the trefoil knot (the minus $\lbrace2,0,0\rbrace$ will be explained shortly). We then take a tubular neighborhood around this knot:

Needs["VectorAnalysis`"]
df[t_] := Evaluate[D[f[t, 3 t/2], t]]
v1[t_] := CrossProduct[df[t], {0, 1, 0}] // Normalize
v2[t_] := CrossProduct[df[t], v1[t]] // Normalize
ParametricPlot3D[
f[t, 3 t/2] + Cos[\[Theta]] v1[t] + Sin[\[Theta]] v2[t],
{t, 0,4 Pi}, {\[Theta], 0, 2 Pi}, Mesh -> None]

(I checked beforehand that the derivative is never in the $\lbrace0,1,0\rbrace$ direction.)

Now I define the composition of a stereographic projection to $S^3$, and one back to $\mathbb{R}^3$. The key is that the latter map can be from any point, so I simply pick one that lies on my knot! [This is why I subtracted $\lbrace2,0,0\rbrace$ before: it ensures the origin lies on the knot, and gives this composition a very easy form.]

s3Proj[v_]:=v/(Norm[v]^2)
ParametricPlot3D[s3Proj[
f[t, 3 t/2] + Cos[\[Theta]] v1[t] + Sin[\[Theta]] v2[t]],
{t, 0,4 Pi}, {\[Theta], 0, 2 Pi}, Mesh -> None]

The problem is (I don't know how to include the picture) that Mathematica is not drawing this torus the way I want. By looking at the "general shape", I know it is the right torus, but for some reason Mathematica is "flaying" the ends of this torus out. I think the problem is due to the fact that any such torus has to travel "inside" itself (basically tracing the knot and then "exiting" itself again), and Mathematica gets confused in how to draw that.

Is there some way to "clean up" this plot? Or maybe someone knows another way to draw an attractive version of this torus?

[My browser is acting up and I cannot tag this question; please feel free to tag it for me.]

Answer 1

Here's how I would do it.

First off, no need to make a curve a function of two variables:

f[t_] := With[{s = 3 t/2}, {(2 + Cos[s]) Cos[t], (2 + Cos[s]) Sin[t], 
    Sin[s]} - {2, 0, 0}]
ParametricPlot3D[f[t], {t, 0, 4 Pi}]

Then you can just use f'[t] as a convenient syntax for D[f[t],t]. Your chosen torus has self-intersections, so I'll define the torus with a lower thickness. Also, it's more natural to take the cross product with the $z$-axis. Using Evaluate makes the plot faster, allowing us to bump up the MaxRecursion in turn.

v1[t_] := Cross[f'[t], {0, 0, 1}] // Normalize
v2[t_] := Cross[f'[t], v1[t]] // Normalize
g[t_, \[Theta]_] := 
 f[t] + (Cos[\[Theta]] v1[t] + Sin[\[Theta]] v2[t])/2
ParametricPlot3D[
 Evaluate@g[t, \[Theta]], {t, 0, 4 Pi}, {\[Theta], 0, 2 Pi}, 
 Mesh -> None, MaxRecursion -> 4]

But your real problem is that you are performing inversion with respect to a point that's not on the central knot, as you claim, but on the surface of the torus instead. Why not just explicitly choose the point using f which we already have?

s3Proj[v_] := v/Norm[v]^2
ParametricPlot3D[
 Evaluate@s3Proj[g[t, \[Theta]] - f[0]], {t, 0, 4 Pi}, {\[Theta], 0, 
  2 Pi}, Mesh -> None, PlotRange -> All, MaxRecursion -> 6, 
 PlotStyle -> Opacity[0.5]]

Actually, using f[2 Pi/3] instead of f[0] gives a more attractive surface. And there you go: a torus with a knot in its hole.