Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

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.

Simulation of Pendulums

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}] &;
share|improve this question
    
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 file size depends mainly on that. Do your really need such a high resolution? With my setup a resolution of 2*72 already looks very nice... –  Albert Retey Mar 15 '13 at 9:16
    
Nope. I feel a bit silly trying such a high-resolution setup. Let me try to see how long exporting the entire video would take now. –  Vincent Tjeng Mar 15 '13 at 9:58
    
If you're coming to this question and interested in an answer, Albert's solution works well enough; most of the time you don't ever need the high resolutions I had in my code. –  Vincent Tjeng Mar 31 '13 at 3:51
    
it is common practice and accepted behavior to answer your own question and even accept it in such cases. As you have triggered my attention to this question, I have added an answer which you can accept, if you think it answers your question... –  Albert Retey Apr 2 '13 at 10:37
    
thank you! still not used to the idea of answering my own question; perhaps I will write up something below if I have anything else to add. –  Vincent Tjeng Apr 2 '13 at 13:06
add comment

1 Answer 1

up vote 4 down vote accepted

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 .

share|improve this answer
add comment

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

Not the answer you're looking for? Browse other questions tagged or ask your own question.