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

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)

• Please define mathematically what you meany by "flying butterfly" !! :) Commented Nov 20, 2015 at 16:26
• @Lotus Perhaps starting from the DNA sequence Commented Nov 20, 2015 at 16:27
• at least please write down that function in mathematica syntax Commented Nov 20, 2015 at 16:29
• @Lotus Something Like this
– vito
Commented Nov 20, 2015 at 16:32

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
]


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


• Neat! (+1) I think your definition of z should be z[t_, a_] := x[t, a] Sign[x[t, a]] Sin[a]. Commented Nov 20, 2015 at 17:19
• @ChipHurst Yup. thanks. An old lurking snippet surviving :) Commented Nov 20, 2015 at 17:26
• Had some fun and made a few changes of my own: Animate[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], PlotPoints -> ControlActive[100, Automatic], Boxed -> False, Axes -> False], {a, .001, Pi/3}, AnimationDirection -> ForwardBackward, AnimationRate -> 1] Commented Nov 20, 2015 at 17:28
• @ChipHurst Nice! I've been playing with a RandomWalk for positions and orientations, but my machine is too slow and it is boring :( Commented Nov 20, 2015 at 17:39

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


• Are you sure you've seen a butterfly flying in real life, J.M.? :)
– user484
Commented Nov 20, 2015 at 17:17
• @Rahul Haven't you been at Chernobyl lately? Commented Nov 20, 2015 at 17:37
• @Rahul, hence the "apologies". :) Commented Nov 20, 2015 at 23:43