Reflections inside a sphere¶

A long time ago I played around with things bouncing around inside of interested regions. I was re-reading that post and I saw that I said

I should note that I started this project wondering what happens in a sphere. But it turns out that it’s super boring

I couldn't remember exactly why it was boring, but I started to think that any initial ray inside a sphere can be thought of as a ray inside a great circle and so I think that the particle will just stay in the plane of that great circle.

Then I stumbled upon NBodySimulation in the Wolfram Engine and found they have a really easy way of doing this. You can set up your simulation (with some very helpful aids like "InverseSquare" as the "PairwisePotential") and also tell it the region in which to do the simulation. Setting the region to a Disk[] in 2D works great:

In [88]:

data  = NBodySimulation[
  Association[
   "Region" -> Disk[]], {<|"Mass" -> 1, "Position" -> {.2, .3}, 
    "Velocity" -> {.4, .5}|>}, 5]

Out[88]:

In [89]:

Show[Region[Disk[]], 
 ParametricPlot[Evaluate[data[All, "Position", t]], {t, 0, 5}], 
 Axes -> True]

Out[89]:

So now let's consider setting the region to a Ball[] in 3D:

In [1]:

data  = NBodySimulation[
  Association["Region" -> Ball[]], 
           Table[<|"Mass"->1, "Position" -> RandomPoint[Ball[]], "Velocity" -> RandomReal[{-1,1},{3}]|>,{5}]
    , 50]

Out[1]:

In [2]:

Show[
 ParametricPlot3D[Evaluate[data[All, "Position", t]], {t, 0, 50}],
 Axes -> True]

Out[2]:

Yep, they all stay in a plane. The triangle one is really interesting, it seems to me.

Ok, so let's have some more fun. Let's turn on some interaction among those 5 particles. You do that with "PairwisePotential"->"InverseSquare"

In [48]:

data  = NBodySimulation[
  Association["PairwisePotential"->"InverseSquare",
   "Region" -> Ball[]], 
           Table[<|"Mass"->1, "Position" -> RandomPoint[Ball[]], "Velocity" -> RandomReal[{-.1,.1},{3}]|>,{5}]
    , 5]

Out[48]:

In [50]:

Show[
 ParametricPlot3D[Evaluate[data[All, "Position", t]], {t, 0, 5}],
 Axes -> True]

Out[50]:

Now let's make a fun animation!

In [86]:

frame[t2_]:=ParametricPlot3D[Evaluate[data[All, "Position", t]], {t, 0.01, t2},PlotPoints->Round[t2/5 1000],Axes->False,Boxed->False];

In [82]:

frames=Table[frame[t3],{t3,0.2,5,.1}];
ListAnimate[frames]

Out[82]:

Your thoughts?¶

Just some fun playing around but I'd love to hear your thoughts. Here are some starters for you:

• This is cool! What if you . . .
• This is dumb. You could just go outside and throw five balls
• Is this faster than setting up your own NDSolve command with a bounce potential at the outside of the Ball[]?
• Why aren't you exploring the cool asteroid simulation that's in the help documents for the Wolfram Engine?
• You pretend that your own old blog post inspired this but I assume Rhett Allain was doing some gravity simulations recently.