FAQ
overflow

QUESTION

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?

ANSWER

Consider this:

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

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]

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]

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]

Tweet