Inertia versus Gravity in 3D

inertiaversusgravity3D=Compile[{{m1,_Real,2},{m2,_Real,2}},{-m2+2m1+ (Plus@@#&/@Map[With[{tt=(#[[1]]^2+#[[2]]^2+#[[3]]^2)},If[tt>0.,#/tt,{0.,0.,0.}]]&,(1-IdentityMatrix[Length[m1]])Outer[Plus,-m1,m1,1],{2}]) ,m1}];

Manipulate[SeedRandom[sr];With[{m=If[circle,N[pts  (#/Norm[#]&/@RandomReal[{-1,1},{pts,3}])], pts RandomReal[{-1,1},{pts,3}]]},DynamicModule[{m1= m,m2= m,hist,i=0},Dynamic[(If[r,i=i+1;{m1,m2}=inertiaversusgravity3D[m1,m2]];
Graphics3D[{Point[m1],Line[Transpose[{m1,m2}]]},ImageSize->{350,350},Boxed->boxed,PlotRange->pra,AspectRatio->1,PlotLabel->i])]]],{{pts,100,"number of points"},3,200,1,Appearance->"Labeled"},{{r,False,"evolve"},{False,True},ControlPlacement->Left},Delimiter,{{circle,False,"init"},{False->"cube",True->"sphere"},ControlPlacement->Left},Delimiter,{{pra,Automatic,"plot"},{Automatic->"most",All->"all"},ControlPlacement->Left},{{boxed,False},{False,True},ControlPlacement->Left},{{sr,0,"random seed"},0,-1+2^24,1,ControlPlacement->Bottom},SaveDefinitions->True,AutorunSequencing->{1,3}]

CAPTION

Start with random points on the surface of a sphere or inside a cube. Evolve the system to see how the points attract each other. Velocities and directions are indicated by arrows which connect old to new positions. Plot all or only most of the points. Select boxed rendering to observe the evolving space of the model.

THIS NOTEBOOK IS THE SOURCE CODE FROM

"Inertia versus Gravity in 3D" from the Wolfram Demonstrations Project
 http://demonstrations.wolfram.com/InertiaVersusGravityIn3D/

Contributed by: Michael Schreiber

A full-function Wolfram Mathematica system (Version 6 or higher) is required to edit this notebook.
GET WOLFRAM MATHEMATICA »

© Wolfram Demonstrations Project & Contributors   |   Terms of Use   |   Make a new version of this Demonstration »