The original (slightly modified here) code can be found at Mathematica Stack Exchange post “Visualizing gravity warping the fabric of spacetime” in the answer given by N0va. Note, this is not Einstein relativity, and only Newton’s gravity law is used below -- a useful background information is the article “The river model of black holes”.
Original intro: “Here my physicist approach to the problem: I consider a cloud/grid of test-particles which get attracted to a reference point by a force. In the following I assume attraction by gravity -- i.e. the force on the test-particle is in line with its distance vector to the reference point and the strength of this force is inverse proportional to the distance squared. For each particle I solve the equations of motion to get the deformation/deflection after a given time. Here a rough first version”
The function
getDeflection
calculates the new position of a test particle under gravitational attraction towards a reference point. It uses
NDSolveValue
to integrate the motion equations up to a specified time or until the distance to the reference point is below a threshold. It returns the deflected position after accounting for gravitational pull, simulating the effect of gravity on space.
In[]:=
getDeflection[x0_, a0_, tend_] := Module[{eqs, x, t, r, t1, d},​​ r = Norm[x0 - a0];​​ If[r < 0.01, Return[x0]];​​ t1 = tend;​​ d = NDSolveValue[{x''[t] == -5/x[t]^2, x'[0] == 0, x[0] == r, ​​ WhenEvent[x[t] < 0.01, t1 = t; "StopIntegration"]}, ​​ x, {t, 0, tend}][t1];​​ x0 - (r - d)/r (x0 - a0)​​]
The function
generateCube
creates a three-dimensional grid of lines that form a cube structure. It takes a dataset and an optional subdivision parameter, then uses
Line
objects to construct the edges of the cube. Each edge is refined into smaller segments based on the subdivision level, resulting in a detailed cube representation.
In[]:=
generateCube[dat_, subdivision_ : 2] := Module[{lines},​​ lines = ​​ Table[{Line[#] & /@ dat[[All, All, i]], ​​ Line[#] & /@ dat[[All, i, All]], Line[#] & /@ dat[[All, All, i]],​​ Line[#] & /@ Transpose[dat][[All, All, i]], ​​ Line[#] & /@ Transpose[dat][[All, i, All]], ​​ Line[#] & /@ Transpose[dat][[All, All, i]]}, {i, 1, Length[dat]}];​​ lines = ​​ lines /. ​​ Line[x_List] :> ​​ MapThread[Line[{#1, #2}] &, {x[[;; -2]], x[[2 ;;]]}];​​ lines /. ​​ Line[{a_, b_}] :> ​​ With[{ab = Subdivide[a, b, subdivision]}, ​​ MapThread[Line[{#1, #2}] &, {ab[[;; -2]], ab[[2 ;;]]}]]​​]
The function
deformCube
modifies existing lines of a cube to simulate gravitational deformation. It calculates new positions for points by applying the
getDeflection
function and updates lines with these new positions. It visualizes the deformation using
Graphics3D
, with color adjustments based on the degree of deformation.
In[]:=
deformCube[lines_, a0_, tend_, f_, opts___] := Module[{pts, linesNew},​​ pts = DeleteDuplicates[​​ Flatten[Flatten[lines] /. Line[{a_, b_}] :> {a, b}, 1]];​​ pts = ParallelTable[x -> getDeflection[x, a0, tend], {x, pts}, ​​ DistributedContexts -> All, Method -> "FinestGrained"];​​ linesNew = ​​ lines /. ​​ Line[{a_, b_}] :> ​​ With[{an = a /. pts, bn = b /. pts}, {Thick, ​​ ColorData["DarkRainbow"][f*(Norm[a - an] + Norm[b - bn])], ​​ Line[{an, bn}]}];​​ Graphics3D[{{White, Sphere[a0, 0.1]}, linesNew}, opts]​​]
A cube grid is generated using a table of points, subdividing each edge into smaller segments to create a detailed structure.
In[]:=
cube = generateCubeTable{i, j, k}, ​​ {i, Subdivide[-1, 1, 3]}, ​​ {j, Subdivide[-1, 1, 3]}, ​​ {k, Subdivide[-1, 1, 3]}, 10;
A sequence of images is generated depicting the deformation of a cube under gravitational forces. Each image corresponds to a different position of the gravitational source, and the deformation is visualized with adjusted colors and lighting.
imgs = Table​​ deformCubecube, 23*{Sin[x], Cos[x], 0}, 0.3, 1.8,
, ​​{x, 0, 2 π, 2π/5};
An interactive display is created showing a sequence of images. It allows users to explore the deformation of a cube under gravitational forces by adjusting a parameter that controls the position within the sequence.
In[]:=
Manipulate[imgs[[k]],{k,1,Length[imgs],1},SaveDefinitions->True]
Out[]=
​
k
Export to animated .GiF:
In[]:=
Export["grav.gif",imgs,ImageSize->550,"DisplayDurations"->.03]
Out[]=
grav.gif

CITE THIS NOTEBOOK

Visualizing space deformation under gravitational forces using Newton's law: particle grid approach​
by Vitaliy Kaurov​
Wolfram Community, STAFF PICKS, December 2, 2025
​https://community.wolfram.com/groups/-/m/t/3584490