General techniques for creating complex animations

Question

I love good animations of abstract concepts, and when I try to create them myself, I prefer doing so in code to make sure they are exact (and because some things are just way too fiddly to do by hand). In general, Mathematica seems like a nice tool for this, because of its powerful plotting capabilities. My problem is that this tends to get quite annoying once my animation consists of multiple "phases", which cannot all be easily described by a single continuous function.

To give you an idea of what I mean, here are some examples from a very popular question over on Math.SE:

^Source

^Source

Note that I'm specifically not talking about animations like the one in the top-voted answer, which can easily be expressed as a large number of graphics primitives whose parameters are continuous functions of some time parameter t.

In the two examples above there are lots of different steps to the animation. Objects appear, disappear or undergo qualitatively different motions over their lifetime (like growing, bending, rotating, translating). I find setting up these animations quite cumbersome (to the extent that when I do manage it, I can no longer be bothered to improve the timing of the animation of add ease-in/out effects to the motions). I usually take some approach with creating fiddly Piecewise functions of bunches of If or Which statements. Whatever I do, it's very ad hoc.

As an example, I've tried to recreate the second GIF above. I didn't even bother with the red flashing and a particularly nice presentation, but all movements are there:

Table[Graphics[{
   Line[{{0, 0}, {1, 0}}],
   Line[{{1, -.1}, {1, .1}}],
   Text[1, {1, -.2}],
   If[t > 0.5, {
     Line[{{1, 0}, {2, 0}}],
     Line[{{2, -.1}, {2, .1}}],
     Text[2, {2, -.2}]
     }, {}],
   If[t > 1, {
     Line[{{0, 0}, ReIm@Exp[I*Min[1, t - 1] Pi/2]}]
     }, {}],
   If[t > 2, {
     Text[1, {-.1, .5}],
     Arrow[{{-.1, 0.35}, {-.1, 0}}],
     Arrow[{{-.1, 0.65}, {-.1, 1}}],
     Line[{{.5, -.1}, {.5, .1}}],
     Text["1/2", {.5, -.2}],
     Line[{{1.5, -.1}, {1.5, .1}}],
     Text["3/2", {1.5, -.2}]
     }, {}],
   If[2 < t <= 3.5, {
     Red,
     Line[{{.5, 0}, {.5, 0} + ({0, 1} - {.5, 0}) Min[1, t - 2]}]
     }, {}],
   If[t > 3.5, {
     Red,
     Line[{{.5, 0}, {.5, 0} + 
        Sqrt@5/2*ReIm@Exp[I*(Pi - ArcTan@2) (1 - Min[1, t - 3.5])]}]
     }, {}],
   If[t > 4.5, {
     Arrow[{{GoldenRatio, 0.35}, {GoldenRatio, 0.05}}],
     Text["\[Phi] \[TildeTilde] 1.1618", {GoldenRatio, 0.5}]
     }, {}]
   },
  PlotRange -> {{-0.25, 2.25}, {-0.25, 1.25}}], {t, 0, 5.5, 0.04}]

This creates a list of frames which you can then stuff into ListAnimate or Export. Here is the result:

My main problems are:

• The cumbersome structure of defining hardcoded time ranges. If I decide I want to shorten or lengthen some segment, it will effect the "time codes" of all subsequent animations.
• Repeated things like Min[1, t - 2] which I need to get a nice parameter that goes from 0 to 1 at some later time.
• Notice that the growing red line is not the same primitive as the rotating red line, although I guess I could have combined them at the expense of even more unclarity. How can easily apply a series of transformation to the same object over time, in a clear way?
• Not very apparent in this example, but often some transformations work better in certain local coordinate systems (e.g. rotation an object about its centre after the animation has moved it away from the origin). Are there easy ways to compose the animations in such a way that I can always pick the most convenient coordinate system for composing a sequence of transformations?
• In this example, I've got a ton of repeated frames when nothing is happening for half a second. Of course, this could be fixed, and then I could use a custom DisplayDurations list for Export, but that makes the construction of the frames even more horrible. How can I work around this?
• I haven't even bothered with elements fading in and out like they do in the first example above, because that would add yet another extra transformation (with hardcoded times) for every single object.

All in all, what are general techniques to make the process of creating such animations with Mathematica more straightforward with particular focus on allowing me to focus more on styling and optimising the timing/trajectories of individual segments?

Another example of types of animations which I'd love to be able to create in a simple way are Animated Mathematica Functions. Apart from the fact that they're animating text, in overall style they're very similar to the above animations. They also raise the question of how to deal with text in a convenient way, for example when you want to "duplicate" part of a string, like when the a, b, c, x are "pulled out" of the function call in the Append animation.

(If the consensus of the answer turns out to be "Mathematica isn't the perfect tool for this", I'd be happy to hear about alternatives in answers or comments, but I'm sure it must be possible to get some decent results with Mathematica.)

Answer 1

If you have recurring requirements, such as stringing together multiple animation segments in sequence, it makes sense to write some helper code to deal with things like timekeeping. You can decide what would be a convenient syntax to describe such an animation, then create functions to convert the convenient syntax to the required graphics expressions.

For example consider an animation that shows a point moving from 0 to 10 along the x axis, taking 5 seconds to do so. It then stays put for 2 seconds before returning to 0, taking 3 seconds. Suppose this could be represented as:

anim[Point[{x, 0}], {{x -> {0, 10}, 5}, 2, {x -> {10, 0}, 3}}]

The first argument is just a graphics expression with one or more symbolic parameters. The second argument is a "plan" for the animation describing how those parameters change over time. Some straightforward processing can analyse the duration of each step and work out how to set the parameter values as a function of time. My attempt at implementing this sort of approach is below. The general aim is to remove the distracting timeline accounting away from the graphics expressions, allowing you to focus on the content and styling of the animation. Eventually you might extend the syntax to add more features or handle more complex sequencing.

A simplish implementation

First the code. I won't try to explain it in detail. Much of it is concerned with handling the multiple variations of the "plan" syntax (described below).

(* timestep processing *)
spat = (_Rule | _Symbol | _String);
expandStep[t_?NumericQ] := {Null, t}
expandStep[x : spat] := {x, 1}
expandStep[{x : spat ..}] := {x, 1}
expandStep[{x : spat .., t_?NumericQ}] := {x, t}

(* expand out simultaneous steps *)
fullsteps[{x__, t_List}] := {#, t} & /@ {x}

(* create animation function *)
anim[gr_, plan_] := Module[{p, gsyms, psyms, syms, tmax},
  p = expandStep /@ plan;
  gsyms = Cases[gr, obj[s_, _] :> s, -1];
  psyms = Cases[p, HoldPattern[s_ -> _] :> s, 2];
  syms = Union@Join[psyms, gsyms];
  p = Prepend[p, Append[Thread[syms -> 0], 0]];
  p[[All, -1]] = sf@p;
  p = Join @@ fullsteps /@ p;
  tmax = p[[-1, -1, 2]];
  With[{pl = p}, {Function[{t}, gr /. Association[clock[t] /@ pl]], tmax}]]

(* list of {start,finish} times for each part *)
sf[x_] := Partition[Accumulate[Last /@ x], 2, 1, {2, 2}, 0]

(* create parameter setting rules from global clock t *)
clock[t_][{_, {st_, _}}] /; t < st := Nothing
clock[t_][{Null, _}] := Nothing
clock[t_][{s_ -> {a_, b_}, {st_, fi_}}] := s -> a + (b - a) Clip[(t - st)/(fi - st), {0, 1}]
clock[t_][{s_ -> {a_, b_}, {fi_, fi_}}] := s -> b
clock[t_][{s_ -> a_, _}] := s -> a
clock[t_][{s : (_Symbol | _String), _}] := s -> 1

(* object appear/vanish/fade *)
SetAttributes[obj, HoldRest]
obj[0, _] := {}
obj[1, x_] := x
obj[r_Real, x_] := Style[x, Opacity[r]]

Usage

The animation "plan" is a list of steps corresponding to consecutive time segments. Allowed steps are:

• x (symbol or string) parameter $x$ is set to 1 (e.g. to make an obj appear - see below)
• x -> a parameter $x$ is set to $a$
• x -> {a, b} parameter $x$ runs from $a$ to $b$
• {step1, step2, ...} multiple of the above steps occur simultaneously in the same time segment
• {step(s), t} the time segment duration is $t$
• t (numeric) pause, i.e. nothing happens for time $t$

The default for $t$ if omitted in any step is $t=1$

The first argument of anim can contain ordinary graphics objects or special named objects:

• obj[name, contents] is a function which evaluates to contents if name is 1 and an empty list if name is 0. This allows for objects to appear and disappear as the animation progresses, by changing the parameter name between 1 and 0.

anim returns a list {func, tmax} where tmax is the total duration of the animation and func[t] returns the appropriate graphics expression for time t.

Example

I suspect an example will be easier to follow than my explanation. Hopefully it is clear how each step of the animation "plan" plays out in the gif.

{f, tmax} = anim[{
    Darker@Green,
    obj["circle", {Circle[{0, 0}, 1, {0, θ}], 
                   Line[{{1, 0}, {0, 0}, {Cos[θ], Sin[θ]}}],
                   Disk[{0, 0}, 0.2, {0, θ}]}],
    Pink,
    obj["label", Text[ToString[r, StandardForm] <> " rad", {0, y}]]},
   {
    {"circle", θ -> {0, 1}},
    {r -> 1, y -> -0.2, "label" -> {0, 1}, 0.5},
    0.5,
    θ -> {1, 2}, r -> 2,
    θ -> {2, 3}, r -> 3,
    θ -> {3, Pi}, r -> Pi,
    {y -> {-0.2, 0.4}, θ -> {Pi, 2 Pi}},
    r -> 2 Pi
    }];

Animate[Graphics[f[t], PlotRange -> 1.2, BaseStyle -> 16], 
  {t, 0, tmax},  AnimationRate -> 1]

Answer 2

This answer is growing bit by bit, though I won't be aiming to reproduce the first animation in OP in its entirety. I am, in fact, addressing just one or two aspects of the problem.

As a follow-up to my comment, I found this quite fast to write, so here it is.

Clear[g]
g[1, t_] = 
  Graphics[{Line[{{0, 0}, {t, 0}}]}, PlotRange -> 1.1, 
   AspectRatio -> 1, ImageSize -> {300, 300}];
g[2, t_] = 
  Unevaluated[g[1, t]] /. DownValues[g] /. t -> 1 /. 
   Line[{{0, 0}, {1, 0}}] -> 
    Unevaluated[
     Sequence[Line[{{0, 0}, {Cos[2 Pi t], Sin[2 Pi t]}}], 
      Circle[{0, 0}, {1, 1}, {0, 2 Pi t}]]];
g[3, t_] = 
  Unevaluated[g[2, t]] /. DownValues[g] /. t -> 1 /. 
   Line[{{0, 0}, {1, 0}}] -> 
    Line[{{1 - Cos[Pi t/2], Sin[Pi t/2]}, {1, 0}}];
g[4, t_] = 
  Unevaluated[g[3, t]] /. DownValues[g] /. t -> 1 /. 
   Line[{{1, 1}, {1, 0}}] -> 
    Circle[{-Cot[t Pi/2], 0}, {Cot[t Pi/2] + 1, Cot[t Pi/2] + 1}, {0, 
      1/(Cot[t Pi/2] + 1)}];
gfull[t_] := 
 Piecewise[{{g[1, t], t < 1}, {g[2, t - 1], t < 2}, {g[3, t - 2], 
    t < 3}, {g[4, t - 3], t <= 4}}]

Re: the problem of tweaking timing, I figured, that each phase may as well have the same duration, and an additional function can fix this. For my example, I find the line rotates through a circle a bit too fast, and I'd like it to pause for a moment at the end when playing this with Animate. Instead of recoding the graphics, I just roll a custom function to pass to gfull instead of simply t fixed, as compared to version from 16.03.16:

phaseDurations = {.2, 1, 3, 1, 1, .2};
timing = Interpolation[
{{0}~Join~Accumulate[phaseDurations],
({0}~Join~Range[0,#]~Join~{#}&)[Length[phaseDurations]-2]}//Transpose,
InterpolationOrder -> 1]
Animate[gfull[timing[t]], {t,0,Total[phaseDurations]}]

Re: problem of both prettyfying things and working in local coordinate systems. Roll your own "primitives"! The code above may have nice functionality, but lets add a little more. I'm thinking, the Graphics should be organized something like Graphics[{{primitives and directives 1}, {prims+dirs 2},...}, Options] so I'll define a custom line like so:

myLine[origin_, length_, angle_] := With[
  {p1 = origin, p2 = origin + length {Cos[angle], Sin[angle]}},
  {Red, PointSize[.02], Point[{p1,p2}], Thick, Line[{p1,p2}]}]

Then I do the previous code again

Clear[g]
Block[{Graphics, myLine},
 g[1, t_] = Graphics[{myLine[{0, 0}, t, 0]},
              PlotRange -> 1.1, AspectRatio -> 1, ImageSize -> {300, 300}];

 g[2, t_] = 
  Unevaluated[g[1, t]] /. DownValues[g] /. t -> 1 /. myLine[{0, 0}, 1, 0] ->
    Unevaluated[Sequence[myLine[{0, 0}, 1, 2 Pi t],
        {Thick, Blue, Circle[{0, 0}, {1, 1}, {0, 2 Pi t}]}]];

 g[3, t_] = 
  Unevaluated[g[2, t]] /. DownValues[g] /. t -> 1 /. 
   myLine[{0, 0}, 1, 2 Pi] -> myLine[{1, 0}, 1, Pi (1 - t/2)];

 g[4, t_] = 
  Unevaluated[g[3, t]] /. DownValues[g] /. t -> 1 /. 
   myLine[{1, 0}, 1, Pi/2] -> 
    Circle[{-Cot[t Pi/2], 0}, {Cot[t Pi/2] + 1, Cot[t Pi/2] + 1},
      {0, 1/(Cot[t Pi/2] + 1)}];
 ]

gfull[t_] = 
  Piecewise[{{g[1, t], t < 1}, {g[2, t - 1], t < 2}, {g[3, t - 2], 
     t < 3}, {g[4, t - 3], t <= 4}}];

Note the Block - I don't want premature evaluation to mess up my replacement rules. Finally, export to gif at 25 fps, thinking of phaseDurations as the timing of each phase in seconds.

Export["test.gif", 
 gfull[timing[#]] & /@ Range[0, Total@phaseDurations, 0.04], 
 "DisplayDurations" -> 
  ConstantArray[0.04, Round[Total@phaseDurations/0.04] + 1]]

Of course, the primitive is not universal - the prettyfied line cannot transform into an arc. Also it briefly flashes red with an error message, as MMA tries to render an arc of fixed length, but infinite radius. But that's just a few more lines of code away. By granularizing all these steps it should be rather easy to create many custom objects, such as that text that has a time-dependent fade, e.g.

fadeText[text_, coords_, t0_, t_] = {Opacity[1 - Exp[-t/t0]], Text[text, coords]}

and at the same time, it will not need a separate hard-coded time slot. For instance, if the main processes in a given phase of the animation last for about 5 seconds, but the text should fade in within half a second, you don't need a 0.5 second sequence with fadeText and then 4.5 seconds with normal Text. Just use fadeText[text,coords,.5,t] and allow it to exist for the entire 5 seconds. It will be completely opaque anyway.