Message Boards Message Boards

10
|
6481 Views
|
2 Replies
|
15 Total Likes
View groups...
Share
Share this post:

[GiF] Periodic n-body systems: motion simulation

Posted 2 years ago

enter image description here

I recently stumbled upon Three Classes of Newtonian Three-Body Planar Periodic Orbits. Here's a quick way to reproduce their findings using NBodySimulation.

periodic3Body2D[vx0_, vy0_, T_, opts : OptionsPattern[NBodySimulation]] :=
 Block[{x10, y10, x20, y20, x30, y30, vx10, vy10, vx20, vy20, vx30, vy30},
  x10 = -1;
  x20 = 1;
  x30 = 0;
  y10 = y20 = y30 = 0;
  vx10 = vx20 = vx0;
  vx30 = -2 vx0;
  vy10 = vy20 = vy0;
  vy30 = -2 vy0;
  NBodySimulation["InverseSquare", {
    <|"Mass" -> 1, "Position" -> {x10, y10}, 
     "Velocity" -> {vx10, vy10}|>,
    <|"Mass" -> 1, "Position" -> {x20, y20}, 
     "Velocity" -> {vx20, vy20}|>,
    <|"Mass" -> 1, "Position" -> {x30, y30}, 
     "Velocity" -> {vx30, vy30}|>
    }, T, opts]
  ]

Here's a plot of the full paths of one orbit group listed in the paper:

{vx0, vy0, T} = {0.41682, 0.33033, 55.7898};

yinyangII = periodic3Body2D[vx0, vy0, T, MaxStepSize -> .001];

plot = ParametricPlot[Evaluate[yinyangII[All, "Position", t]], {t, 0, 55.7898}, 
   PlotPoints -> 100, PlotStyle -> AbsoluteThickness[1], 
   Background -> Black, Axes -> False, ImageSize -> 1024, 
   MaxRecursion -> 13] /. Line -> BSplineCurve

enter image description here


Let's write a helper function to plot the three bodies with a trailing orbit at a given time.

First let's find the position of each body at an arbitrary time t. Here we add the capability of sampling over any time point injecting Mod:

bodyPos = yinyangII[All, "Position", t] /. t -> Mod[t, T];

Next, for each body we'll sample from t-1 to t to form a trail. We'll make each vertex in the trail more transparent the closer to t-1 it is. We also represent each body as a point. The use of Transpose ensures the points lie on top of all trails, which comes in handy during a close encounters.

makeFrame[Ts_] :=
  Graphics[
    Transpose@Table[
      With[{c = ColorData[97, i], vals = Table[Evaluate@bodyPos[[i]], {t, Ts - 1, Ts, .001}]},
        {
          {Thick, Line[vals, VertexColors -> Thread[Append[c, Range[0., 1, .001]]]]},
          {PointSize[Large], c, Point[vals[[-1]]]}
        }
      ],
      {i, 3}
    ],
    Axes -> False,
    Background -> Black,
    PlotRange -> {{-1.09, 1.09}, {-0.89, 0.89}},
    PlotRangePadding -> Scaled[.05]
  ]

Here's the configuration at time t == 21: enter image description here

This could make for a nice screensaver. Let's make a 60 second 10 fps gif:

framecnt = 600;

frames = Monitor[
  Table[
    Rasterize[makeFrame[Ts]],
    {Ts, Subdivide[0, T, framecnt - 1]}
  ],
  Row[{ProgressIndicator[Ts, {0, T}], " ", Ts/T}]
]; // AbsoluteTiming

(* {220.461, Null} *)

Export["orbital_yinyangII.gif", Most[frames], AnimationRepetitions -> ∞, "DisplayDurations" -> 0.1];
POSTED BY: Greg Hurst
2 Replies

Beautiful work, Greg! I really enjoyed reading that paper when I discovered it a few years ago. There is also a nice demonstration by @Enrique Zeleny

Recently Discovered Periodic Solutions of the Three-Body Problem

https://demonstrations.wolfram.com/RecentlyDiscoveredPeriodicSolutionsOfTheThreeBodyProblem

enter image description here

POSTED BY: Vitaliy Kaurov

enter image description here -- you have earned Featured Contributor Badge enter image description here Your exceptional post has been selected for our editorial column Staff Picks http://wolfr.am/StaffPicks and Your Profile is now distinguished by a Featured Contributor Badge and is displayed on the Featured Contributor Board. Thank you!

POSTED BY: Moderation Team
Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Reply Preview
Attachments
Remove
or Discard

Group Abstract Group Abstract