# Creating an animation illustrating the time-evolution of a pre-computed orbit

As the title says, I would like to use Mathematica in order to create an animation depicting the time-evolution of a three-dimensional (3D) orbit. To begin with, I have an ASCII file which contains the orbit data into four columns. The first column corresponds to the time, while the next three to the x, y and z coordinates respectively. Below, I present a simple code so as to visualize the orbit.

SetDirectory[" ... "];
data = ReadList["orb_3d.out", Number, RecordLists -> True];
dataOrb3D = Table[{data[[i, 2]], data[[i, 3]], data[[i, 4]]},
{i, 1, Length[data]}];
S0 = Graphics3D[Line[dataOrb3D], Axes -> True, AxesStyle ->
Directive[FontSize -> 17, FontFamily -> "Helvetica"], AxesLabel ->
{"x", "y", "z"}, BoxRatios -> {1, 1, 1}, ImageSize -> 500]


The above code produces this image:

OK, so far so good. Now let me explain the simulation part. The orbit describes the motion of a test-particle (star) under the gravitational field of a galaxy. According to the data file, when t=0 the star must be at (x,y,z) = (0.5,0,0.5). So, I would like to plot at that point, let's say a blue dot, inside the 3D volume. Then as time evolves the blue dot which indicates the star should follow the path according to the data file moving from point to point, join them thus leaving a solid line behind it. When t=250 the simulation finishes and we should have reproduced the image I present earlier.

Honestly, I am not sure if what I described is possible with Mathematica. Anyway, it would be great, if there was also a label inside the 3D box (or above it) giving the value of the time at every step of the simulation (i.e. t = 73.27). Finally, I would also like to be able to export this simulation as an .avi or .mp4 file.

I know that I described a very ambitious project here! However, I also think that it is a very interesting topic. Many many thanks in advance and I look forward for your replies.

-
By the way, this is not really simulation; this is just animation. Simulation would be if you gave us only the inverse square law and the initial state of the particle, and asked us to plot its orbit. –  Rahul Dec 21 '12 at 15:26
@RahulNarain YES! You are absolutely right; it is just an animation. The simulation or if you prefer the numerical integration of the equations so motion was made using a FORTRAN algorithm. The output was the ASCII data file. –  Vaggelis_Z Dec 21 '12 at 15:37
Why not perform the numerical integration in Mathematica as well? NDSolve is amply able to deal with equations of motion. –  Mark McClure Dec 21 '12 at 16:01
@MarkMcClure Indeed, Mathematica could also perform the numerical integration of the equations of motion. However, my experience shows that the corresponding FORTRAN code is always much faster. Moreover, if you want to integrate for vast time intervals using Mathematica you may run out of memory! I could post such an example. –  Vaggelis_Z Dec 21 '12 at 16:06
fortran is probably faster, indeed, but your experience also told you that this would be an ambitious project whereas it's actually trivial in mathematica! my point is that mathematica can be made to do things that surprise most people (on the other hand, it's debatable whether the effort necessary to learn enough to do that is worth it) –  acl Dec 21 '12 at 16:16

A few important things:

• Fix PlotRange so the axes won't rescale constantly - otherwise you will have no sense of the orbit scale as it progresses
• Set SphericalRegion -> True for a nice feel of box rotation
• Want animation not to get stuck while you are rotating the box? - wrap Dynamic around the internal content of Graphics3D
• Note the AnimationRate option for setting speed of the orbit progress

Here you go:

SetDirectory[NotebookDirectory[]];
data = ReadList["orb_3d.out", Number, RecordLists -> True];
space = data[[All, 2 ;; 4]];

Manipulate[
Graphics3D[Dynamic@{
{GrayLevel[.7], Line[space[[1 ;; t]]]},
{Red, PointSize[.02], Point[space[[t]]]},
},
Axes -> True,
AxesStyle -> Directive[FontSize -> 17, FontFamily -> "Helvetica"],
AxesLabel -> {"x", "y", "z"}, BoxRatios -> {1, 1, 1},
ImageSize -> 400, PlotRange -> 10, SphericalRegion -> True],
Row[{Control[{t, 1, Length[data], 1, Animator, ImageSize -> Small,
AnimationRunning -> False, AnimationRate -> 50,AnimationRepetitions -> 1}], Spacer[10],
Dynamic["time = " <> ToString[data[[t, 1]]]]}],
FrameMargins -> 0]


To export to movie

Export["test.avi", %]


To export without interface - replace Manipulate with Table and then export the resulting list of graphics to .GIF or .AVI. or similar. See related documentation for flexible options - like looped or single run - for .GIF it is "AnimationRepetitions".

-
Great, simply amazing! Only, a couple of minor issues left now. (1). How can I change the properties of the moving point (size, color, etc)? (2). Is there a way to display the exact time somewhere during the simulation? (3). When the simulation ends I want the image to freeze not starting again. (4). Is it possible to export the simulation as an .avi or mp4. file? –  Vaggelis_Z Dec 21 '12 at 15:23
@Vaggelis_Z please state whatever you need from the very beginning in your question - don't have too much time to go changing code. (1) all options are in the code - examine attentively; (2) I displayed time now; (3) exported movie to .AVI or .GIF will stop if you set propper options. You can find a lot of useful info reading help - just search in documentation for AVI, GIF, Manipulate, or Dynamic –  Vitaliy Kaurov Dec 21 '12 at 15:50
Thanks a lot! One minor issue is left. At the end of the animation (t=250), I would like the animation to freeze there not restarting all over again. Is this possible? –  Vaggelis_Z Dec 21 '12 at 16:14
@Vaggelis_Z Yes, this is "AnimationRepetitions -> 1" option - I added it to the code. –  Vitaliy Kaurov Dec 21 '12 at 16:19
@Vaggelis_Z As with most options, "AnimationRepetitions" is well documented: reference.wolfram.com/mathematica/ref/Animate.html#878404649 –  Mark McClure Dec 21 '12 at 16:23

Here is one that uses the Tube primitive, where the front of the tube is a little thicker than the tail. It also uses a non-stationary ViewPoint which creates the illusion of flying around the animation and zooming in and out of it. The DisplayAllSteps option makes sure than Animate does not skip any intermediate steps:

points = Import["Downloads/orb_3d.out", "Table"][[All, 2 ;; 4]];

length = Length[points];
step = 10;
tubeLength = 200;

Animate[
Graphics3D[{
{Blue, Sphere[]},
Tube[points[[i ;; i + tubeLength]],
Table[i/(4 tubeLength), {i, 1, tubeLength + 1}]
]},
PlotRange -> 30,
Background -> Black,
ImageSize -> Large,
Lighting -> "Neutral",
ViewPoint -> (6 + 5 Cos[i/500]) {Cos[i/1000.], Sin[i/1000.], Sin[i/2000]},
SphericalRegion -> True
], {i, 1, length - tubeLength, 10}, DisplayAllSteps -> True]


-
+1 The tube is a great idea for giving a 3D visual cue. –  whuber Dec 21 '12 at 21:09

It's fairly easy to export to an animation. Here's one way to export the first tenth of it to an animated GIF. Other formats can be done by simply changing the extension.

$Path = Prepend[$Path,
data = Import["orb_3d.out", "Table"];
positions = Rest /@ data;
pic[n_] := Graphics3D[{
{Opacity[0.2], Line[positions]},
{Line[positions[[1 ;; n]]],
PointSize[Large], Blue, Point[positions[[n]]]}
}];
pics = Table[pic[n], {n, 1, 2501, 25}];
Export["anim.gif", pics];


-
I would like to thank you for your illuminating instructions! –  Vaggelis_Z Dec 21 '12 at 16:31

# Minimal modifications

It's almost trivial to do this with minor modifications to your code:

data = ReadList["orb_3d.out.txt",
Number, RecordLists -> True];

Manipulate[
dataOrb3D =
Table[{data[[i, 2]], data[[i, 3]], data[[i, 4]]}, {i, 1, uplim}];
Graphics3D[
{Line[dataOrb3D], Sphere[data[[uplim, 2 ;; -1 ]], .5 ]},
Axes -> True,
AxesStyle -> Directive[FontSize -> 17, FontFamily -> "Helvetica"],
AxesLabel -> {"x", "y", "z"},
BoxRatios -> {1, 1, 1}, ImageSize -> 500,
PlotRange -> {{-15, 15}, {-15, 15}, {-15, 15}}
],
{uplim, 1, Length@data, 1}
]


(I just moved dataOrb3D inside a Manipulate, fixed the plot range, and inserted a sphere at the end of the line).

# Slightly tidier code

I'd prefer it like this though (no extra Table at the beginning):

Manipulate[
Graphics3D[
{Line[data[[1 ;; uplim, 2 ;; -1]] ],
Sphere[data[[uplim, 2 ;; -1 ]], .5 ]},
Axes -> True,
AxesStyle -> Directive[FontSize -> 17, FontFamily -> "Helvetica"],
AxesLabel -> {"x", "y", "z"},
BoxRatios -> {1, 1, 1}, ImageSize -> 500,
PlotRange -> {{-15, 15}, {-15, 15}, {-15, 15}}
],
{uplim, 1, Length@data, 1}
]


# The Earth

Embellishments are also possible. For instance, let's add a tiny Earth:

pl = Import[
"http://eoimages.gsfc.nasa.gov/images/imagerecords/57000/57752/land_\
shallow_topo_2048.tif"];

earth = SphericalPlot3D[1 , {u, 0, Pi}, {v, 0, 2 Pi},
Mesh -> None,
ImageSize -> 100,
TextureCoordinateFunction -> ({#5, 1 - #4} &),
PlotStyle -> Directive[Specularity[White, 10], Texture[pl]],
Lighting -> "Neutral",
Axes -> False,
RotationAction -> "Clip",
Boxed -> False
]

Manipulate[
Show[
{
Graphics3D[
{Pink, Line[data[[1 ;; uplim, 2 ;; -1]] ]},
Axes -> True,
AxesStyle -> Directive[FontSize -> 17, FontFamily -> "Helvetica"],
AxesLabel -> {"x", "y", "z"},
BoxRatios -> {1, 1, 1}, ImageSize -> 500,
PlotRange -> {{-15, 15}, {-15, 15}, {-15, 15}}
],
Graphics3D[Scale[Translate[earth[[1]], data[[uplim, 2 ;; -1]]], 2]]
},
Lighting -> "Neutral"
],
{uplim, 1, Length@data, 1}
]


Note the use of earth[[1]] in Graphics3D[Translate[earth[[1]], data[[uplim, 2 ;; -1]]]]; this is necessary to extract the GraphicsComplex, otherwise Translate doesn't work. It's a shame we can't use Texture with primitives like Sphere.
Exporting to a gif is easy; replace the Manipulate by a Table, then export the resulting list as Export[fname,list].