# Drawing a torus not bounding a solid torus

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.]

-
Is the last ParametricPlot3D command correct? (s3Proj is never used) –  ssch Dec 19 '12 at 19:42
@ssch: Oh no it isn't, thank you! –  Steve D Dec 19 '12 at 19:46
Just a related note: You can get different kinds of knots using KnotData. You can get a trefoil with KnotData["Trefoil"] and its parametric curve with KnotData["Trefoil", "SpaceCurve"] –  The Toad Dec 19 '12 at 19:46
Your knot surface has self-intersections, which make it look very confusing when you turn it inside out. You could try making it less thick. Beyond that, I'm with wxffles here: it would really help if you could explain more clearly what you mean by "drawing this torus the way I want". Perhaps with some sort of a sketch of the shape you expect to see? Anyway, I played around with it and the best I could get is i.stack.imgur.com/sPXs0.png –  Rahul Dec 19 '12 at 22:14
@RahulNarain: And now I feel stupid...the picture is coming out much nicer now. I am going to increase MaxRecursion to get a smoother plot, but I will post a picture when Mathematica finishes. Thanks!! –  Steve D Dec 20 '12 at 5:24

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.

-
You are awesome! Can I ask a tangential question, as I am now completely satisfied with this answer: why does Evaluate make things faster? –  Steve D Dec 20 '12 at 5:34
From the documentation: "Plot has attribute HoldAll and evaluates $f$ only after assigning specific numerical values to $x$. In some cases, it may be more efficient to use Evaluate to evaluate $f$ symbolically before specific numerical values are assigned to $x$." The same is true of ParametricPlot3D` and most other plotting functions. –  Rahul Dec 20 '12 at 6:06