Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

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

share|improve this question
    
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
2  
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"] –  rm -rf Dec 19 '12 at 19:46
1  
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 Narain Dec 19 '12 at 22:14
1  
@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
show 5 more comments

1 Answer

up vote 9 down vote accepted

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

enter image description here

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]

enter image description here

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

enter image description here

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.

enter image description here

share|improve this answer
    
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
2  
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 Narain Dec 20 '12 at 6:06
add comment

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

Not the answer you're looking for? Browse other questions tagged or ask your own question.