Exporting a Video of a Simulation of Pendulum Motion

Question

In a series of previous questions, I asked how to solve a series of differential equations describing a series of coupled pendulums, and then how to plot this data by coloring the different pendulums. Using the excellent answers from these two questions, I was able to output a 3-dimensional view of how the pendulums swing.

My system's graphics card is pretty outdated, so using Szabolcs' poor man's antialiasing, I attempted to output a movie of the pendulums' motion.

To begin with, my code to generate the individual 3-dimensional views at a given point of time is shown below.

funcposition = Table[{Sin[# + i], 1}, {i, 0, n, 1}] &;

(*the position function of each pendulum, as a function of time. note - this is a dummy variable; you can see the explanation below of why I used a dummy variable. The variable # is the time*)

connectionpoints = 
  Transpose[{Table[i, {i, 0, n}], Table[0, {i, 0, n}], 
    Table[0, {i, 0, n}]}];

(*the points where the balls are connected to the supporting stick*)

supportstick = {Black, Thick, Line[{{0, 0, 0}, {n, 0, 0}}]};

(*the thick black supporting stick*)

toPolar = {#2 Cos[# - \[Pi]/2], #2 Sin[# - \[Pi]/2]}\[Transpose] & @@ (#\[Transpose]) &;

(*Mr Wizard's method for coloring the points and producing the output here*)

colors = ColorData["Rainbow"] /@ Rescale@Range@Length@funcposition[0];

(*A three-dimensional plot of the data, including the antialiasing*)

antialiasedthreedpendulumviewer = 
  ImageResize[
    Rasterize[
     Graphics3D[{PointSize[Large], 
        Point[Transpose[
          Prepend[Transpose[toPolar@funcposition[#1]], 
           Range[n + 1] - 1]], VertexColors -> colors]}~Join~
       supportstick~Join~{Black, Thin}~
       Join~(Line /@ 
         Partition[
          Riffle[Transpose[
            Prepend[Transpose[toPolar@funcposition[#1]], 
             Range[n + 1] - 1]], connectionpoints], 2]), 
      PlotRange -> {{-1, n + 1}, {-1, 1}, {-1, 1}}, Axes -> True, 
      ViewPoint -> #2, ImageSize -> Large], "Image", 
     ImageResolution -> 8*72], Scaled[1/4]] &;

To export the images as a video, I then apply the following:

starttime=0;
endtime=0.5;
timestep=0.005
perspective={-0.87, 0.25, 0}

tableofimages = 
Table[antialiasedthreedpendulumviewer[tdummy, perspective], {tdummy, starttime, endtime, timestep}];
Export["animation.flv", tableofimages]

However, this process is very slow, and producing even ten frames took me three minutes.

My question is - how do we improve the performance of the exporting process? As a side question, how would we reduce the file size of the file exported?

Note: The actual motion of the coupled pendulums is replaced with a toy function in this running example above, as I don't think that the evaluation of the solution is the key rate-determining step for the exporting of the video in the simulation. The actual code that I am running involves solving the ODE first and also replace the funcposition with a substitution of the functions' solution.

m = 0.1;
l = 0.2;
b = 1;
mu = 1;
k = 10;
eta = 0.2;
g = 0.2;
a = 1;

g = 9.81;

n = 20;
tmax = 20;

funch = (1 - eta/(2 (1 - Cos[#1 - #2]) + (g/a)^2)^0.5) &;
funcf = # + Abs[#] &;
tau = Sin[#1 - #2]*k*l^2*funcf[funch[#1, #2]] &;

node = b*m*l^2*
     D[theta[#][t], {t, 2}] == -g*m*mu*l*
      Sin[theta[#][t]] + tau[theta[# - 1][t], theta[#][t]]*
      HeavisidePi[(#*(1 + n*$MachineEpsilon) - 1)/n - 0.5] + tau[
       theta[# + 1][t], theta[#][t]]*
      HeavisidePi[(#*(1 - n*$MachineEpsilon) + 1)/n - 0.5] &;
(*machine epsilon bit is to make side pendula only affected by \
themselves*)

initialposition = theta[#][0] == 0 &;
initialvelocity = theta[#]'[0] == 0 &;

initialconditions = {theta[0][0] == 0, theta[0]'[0] == 50, 
    theta[1]'[0] == 45, theta[2]'[0] == 40, theta[3]'[0] == 35, 
    theta[4]'[0] == 30, theta[5]'[0] == 25}~Join~
   Table[initialposition[i], {i, 1, n}]~Join~
   Table[initialvelocity[i], {i, 6, n}];

(*initial conditions defined as above*)

equations = Table[node[i], {i, 0, n}];
system = equations~Join~initialconditions;
functions = Table[theta[i][t], {i, 0, n}];
solution =  NDSolve[system, functions, {t, 0, tmax}, MaxSteps -> 10000*n*tmax];

funcposition = Table[{(Evaluate[theta[i][t] /.solution] /.t -> #)[[1]], 1}, {i, 0, n, 1}] &;

Answer 1

As some simple comparisons confirm, the main time in creating the images is spent in the Rasterize function and that time has -- not to much surprise -- a quadratical dependence on the image resolution.

I have not tested it, but I guess that the Export behaves similar, and of course also the final file size and intermediate memory usage depends on the resolution used.

It turns out that the OP didn't really need the very high resolution originally defined with ImageResolution->8*72. With a lower resolution of e.g. 2*72 the plots already look very nice and the creation and export of the rasterized images is done in reasonable time.

If one really needs very high resolutions one needs to pay a price, and it probably is a good idea to initially use low resolutions to get everything running correctly and only in a last step increase the resolution to the desired value to produce the final result once.

Mathematicas export functions for movies are probably not optimized for such very high resolution cases so that it could well be that an export won't work due to extensive memory allocations. In such cases one could try to export just single frames and use external programs to convert these single frames into a high resolution video, some possibilities are described in the answers to these questions: variable frame rate, save as mp4. There are some other tricks that are good to know when trying to export videos in the answers to these questions: prerender animation, export to mov .