Animate $2D$ butterfly curve in $3D$

Question

There is a butterfly curve $$r(\theta)=e^{\sin(\theta)}-2.4\cos(4\theta)+\sin \bigg( \frac{\theta}{12} \bigg)^5$$

PolarPlot[
  E^Sin[θ] - 2.4 Cos[4 θ] +Sin[θ/12]^5, {θ, 0, 24 Pi}, 
  PlotStyle -> {Thickness[0.004], Black}, PlotPoints -> 150]

How to animate it in 3D as a flying butterfly in Mathematica?

(Sorry for my English)

Answer 1

Here's one where we treat the abdomen differently.

First, look at this as a 2D parametric curve:

r[t_] := E^Sin[t] - 24/10 Cos[4 t] + Sin[t/12]
x[t_] := r[t] Cos[t]
y[t_] := r[t] Sin[t]

We can locate the abdomen by carefully partitioning the roots of x[t].

vals = First[Cases[Plot[Evaluate[x[t, 0]], {t, 0, 20π}], Line[l_] :> l, ∞]];

xroots = t /. FindRoot[x[t], {t, ##}, WorkingPrecision -> 30] & @@@
 Select[Partition[vals, 2, 1], Sign[#[[1, 2]]] != Sign[#[[2, 2]]] &][[All, All, 1]];

We now will define the abdomen through inequalities of our parameter t.

AbdomenQ[r_] := With[{s = Chop@y[r]},
  s < 0 || (s > 1 && s > Chop@y[r - 1/100])
]

abdomenextrema = Select[xroots, AbdomenQ];

abdomen = N[Or @@ (#1 <= t <= #3 & @@@ 
  Cases[Partition[xroots, 3, 1], {_, Alternatives @@ abdomenextrema, _}])];

Now when we define our 3D parametric equation, we need to make sure our point rotates if and only if it's on a wing.

r[t_] := E^Sin[t] - 24/10 Cos[4 t] + Sin[t/12]
(x[t_, a_] := If[#, r[t] Cos[t], r[t] Cos[t] Cos[a]]) &[abdomen]
y[t_, a_] := r[t] Sin[t]
(z[t_, a_] := If[#, 0., Sign[a] Abs[r[t] Cos[t] Sin[a]]])&[abdomen]

We also keep the abdomen black and make the wings colorful.

cf = Function[{x, y, z, t}, 
  If[#,
    Black,
    #2[Sqrt[x^2 + y^2]/6]
  ]
]&[abdomen, ColorData["FruitPunchColors"]];

And now we place this in a nicely formatted Animate.

Animate[ParametricPlot3D[{x[t, a], y[t, a], z[t, a]}, {t, 0, 20π}, 
   PlotRange -> 8 {{-1, 1}, {-1, 1}, {-1, 1}}, 
   PlotPoints -> ControlActive[100, Automatic], 
   ColorFunction -> cf, 
   ColorFunctionScaling -> False, 
   Boxed -> False, 
   Axes -> False
  ], 
  {{a, 0.001}, -Pi/6, Pi/2}, 
  AnimationDirection -> ForwardBackward, 
  AnimationRate -> 1
]

Answer 2

r[t_] := E^Sin[t] - 24/10 Cos[4 t] + Sin[t/12]
x[t_, a_] := r[t] Cos@t Cos@a
y[t_, a_] := r[t] Sin@t
z[t_, a_] := x[t,a] Sign[x[t,a]] Sin@a

Manipulate[
 ParametricPlot3D[{x[t, a], y[t, a], z[t, a]}, {t, 0, 20 Pi}, 
  PlotRange -> 8 {{-1, 1}, {-1, 1}, {-1, 1}},
  ColorFunction -> Function[{x, y, z, u}, Hue@z]], {a, 0, Pi}]

Answer 3

(with apologies to Temple Fay)

Animate[ParametricPlot3D[{Cos[θ], Sin[θ], (1 + 2 Abs[t - 1]) (1 - Abs[t - 1])^2 - 1/2}
                         (Exp[Cos[θ]] - 2 Cos[4 θ] + Sin[θ/12]^5), {θ, 0, 24 π}, 
                         Axes -> None, Boxed -> False, PerformanceGoal -> "Quality", 
                         PlotRange -> {{-4, 4}, {-4, 4}, {-3, 3}}, 
                         PlotStyle -> Directive[AbsoluteThickness[1], ColorData[97, 2]]],
        {t, 0, 2 - 1/20, 1/20}]