13
$\begingroup$

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:

enter image description here

In order to obtain the ASCII data file, please follow this link.

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.

$\endgroup$
8
  • 1
    $\begingroup$ 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. $\endgroup$
    – user484
    Dec 21, 2012 at 15:26
  • $\begingroup$ @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. $\endgroup$
    – Vaggelis_Z
    Dec 21, 2012 at 15:37
  • $\begingroup$ Why not perform the numerical integration in Mathematica as well? NDSolve is amply able to deal with equations of motion. $\endgroup$ Dec 21, 2012 at 16:01
  • $\begingroup$ @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. $\endgroup$
    – Vaggelis_Z
    Dec 21, 2012 at 16:06
  • 1
    $\begingroup$ 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) $\endgroup$
    – acl
    Dec 21, 2012 at 16:16

4 Answers 4

11
$\begingroup$

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]

enter image description here

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".

$\endgroup$
8
  • $\begingroup$ 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? $\endgroup$
    – Vaggelis_Z
    Dec 21, 2012 at 15:23
  • 2
    $\begingroup$ @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 $\endgroup$ Dec 21, 2012 at 15:50
  • $\begingroup$ 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? $\endgroup$
    – Vaggelis_Z
    Dec 21, 2012 at 16:14
  • $\begingroup$ @Vaggelis_Z Yes, this is "AnimationRepetitions -> 1" option - I added it to the code. $\endgroup$ Dec 21, 2012 at 16:19
  • $\begingroup$ @Vaggelis_Z As with most options, "AnimationRepetitions" is well documented: reference.wolfram.com/mathematica/ref/Animate.html#878404649 $\endgroup$ Dec 21, 2012 at 16:23
14
$\begingroup$

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]

Star around black hole animation

$\endgroup$
1
  • $\begingroup$ +1 The tube is a great idea for giving a 3D visual cue. $\endgroup$
    – whuber
    Dec 21, 2012 at 21:09
10
$\begingroup$

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,
   FileNameJoin[{HomeDirectory[], "Downloads"}]];
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];

enter image description here

$\endgroup$
1
  • $\begingroup$ I would like to thank you for your illuminating instructions! $\endgroup$
    – Vaggelis_Z
    Dec 21, 2012 at 16:31
10
$\begingroup$

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

enter image description here

A couple of comments.

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

$\endgroup$
1
  • $\begingroup$ Many many thanks! $\endgroup$
    – Vaggelis_Z
    Dec 21, 2012 at 16:30

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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