23
$\begingroup$

The surface show below is very beautiful; however, I don't know its function either as an implicit function or in parametric form.

Anyone have an idea about it and how to draw it with Mathematica?

Beautiful surface

$\endgroup$
17
  • 3
    $\begingroup$ One way might be to browse on-line the Mathematica GUIDE book for graphics by Trott at google books books.google.com/… If anyone done something like the above, it will be in that book. Many more amazing plots there. $\endgroup$
    – Nasser
    Nov 24, 2013 at 9:15
  • 5
    $\begingroup$ Do you have any affiliation with this? translate.google.com/… $\endgroup$ Nov 24, 2013 at 16:45
  • $\begingroup$ Can you please give an answer to @belisarius. You have had 4 days to respond and you are back here again today. $\endgroup$ Nov 28, 2013 at 1:07
  • $\begingroup$ @belisarius I have no access to this due to the network being blocked $\endgroup$ Nov 28, 2013 at 1:48
  • $\begingroup$ Strange ... at least @MikeHoneychurch, four others and me aren't suffering any blocking. Someone is playing dirty with your network access. $\endgroup$ Nov 28, 2013 at 1:51

2 Answers 2

52
$\begingroup$

Consider this:

ParametricPlot3D[
 RotationTransform[a, {0, 1, 0}][{0, 0, Sin[3 a] + 5/4}],
  {a, 0, 2 Pi}, Evaluated -> True]

enter image description here

Now rotate this around a circle, while rotating it at the same time around its' origin:

ParametricPlot3D[
 RotationTransform[b, {0, 0, 1}][{6, 0, 0} + 
   RotationTransform[a + 3 b, {0, 1, 0}][{0, 0, Sin[3 a] + 5/4}]],
    {a, 0, 2 Pi}, {b, 0, 2 Pi}, PlotPoints -> 40, Evaluated -> True]

enter image description here

EDIT:

A color function, omitting surface mesh, fixing direction of rotation and adding a hint of transparency, like the original:

ParametricPlot3D[
 RotationTransform[b, {0, 0, 1}][{6, 0, 0} + 
   RotationTransform[a - 3 b + Pi, {0, 1, 0}][{0, 0, Sin[3 a] + 5/4}]],
 {a, 0, 2 Pi}, {b, 0, 2 Pi}, PlotPoints -> 40, 
 ColorFunction -> (RGBColor[#, 0, 1 - #, 4/5] &[1/2 + {1, -1}.{#1, #2}/2] &),
 Mesh -> False, Evaluated -> True]

enter image description here

This might be slightly more intuitive way to write ColorFunction using Blend and Opacity in PlotStyle:

ParametricPlot3D[
 RotationTransform[b, {0, 0, 1}][{6, 0, 0} + 
   RotationTransform[a - 3 b + Pi, {0, 1, 0}][{0, 0, Sin[3 a] + 5/4}]],
 {a, 0, 2 Pi}, {b, 0, 2 Pi},
 PlotPoints -> 40, 
 PlotStyle -> Opacity[4/5], 
 ColorFunction -> (Blend[{Red, Blue}, 1/2 + {1, -1}.{#1, #2}/2] &), 
 Mesh -> False, Evaluated -> True]
$\endgroup$
12
  • 2
    $\begingroup$ (+1 i) Thank you! :) $\endgroup$
    – cormullion
    Nov 24, 2013 at 10:14
  • 2
    $\begingroup$ Very nice use of RotationTransform $\endgroup$ Nov 24, 2013 at 13:11
  • 3
    $\begingroup$ @cormullion, I love the imaginary upvote. +Sqrt[2I] :-) $\endgroup$ Nov 24, 2013 at 13:12
  • 1
    $\begingroup$ @SimonWoods Now we just need to figure out how to Abs[] them for a rep boost :D $\endgroup$
    – rm -rf
    Nov 24, 2013 at 15:07
  • 1
    $\begingroup$ Congratulations on an elusive Guru badge. :-) (Elusive to everyone but Leonid, that is.) $\endgroup$
    – Mr.Wizard
    Jul 28, 2014 at 13:02
21
$\begingroup$

I'm adding this answer to put on record an answer to the second part the question, "what is the parametric equation?".

The parametric equation is implicit in Kirma's RotationTransform expression. To extract it, one need simply write something like

Clear[a, b]
quoit[a_, b_] := 
  Evaluate @ RotationTransform[b, {0, 0, 1}][{6, 0, 0} + 
    RotationTransform[a - 3 b + Pi, {0, 1, 0}][{0, 0, Sin[3 a] + 5/4}]]

The function defined by the above expression, looks like this

Definition @ quoit
quoit[a_, b_] := 
   {
     Cos[b] (6 - (5/4 + Sin[3 a]) Sin[a - 3 b]), 
     (6 - (5/4 + Sin[3 a]) Sin[a - 3 b]) Sin[b], 
     -Cos[a - 3 b] (5/4 + Sin[3 a])
   }
$\endgroup$
3
  • $\begingroup$ thank you very much ! very useful $\endgroup$ Nov 24, 2013 at 15:47
  • $\begingroup$ Indeed; maybe I left this part a bit too much implied. $\endgroup$
    – kirma
    Nov 24, 2013 at 17:23
  • 4
    $\begingroup$ Also the order of wrapping rotation matrix is critical. When the foil rotates around the circle (outmost transform function), the Z axis is fixed. While it spins about its center, the attached Z axis changes direction. Thats why the transform with {0,1,0} is inside the first transform. $\endgroup$
    – yshk
    Nov 25, 2013 at 2:16

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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