[このノートブックは以下のcommunityのポストをLLMツールにより日本語に翻訳したものです：
​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]

ニュートンの法則による重力下の空間変形の可視化：粒子・格子アプローチ

by Vitaliy Kaurov
もとのコード（ここでは少し変更されている）は，Mathematica Stack Exchange 投稿 “Visualizing gravity warping the fabric of spacetime” における N0va による回答に見出されるものである．
ここで述べる内容はアインシュタインの相対論ではなく，下ではニュートンの重力の法則のみを用いる点に注意する背景情報として，“Visualizing gravity warping the fabric of spacetime”の記事を参照されたい．
もとの回答のイントロ: “ここでは問題に対する物理学者的アプローチを述べるものである．すなわち，基準点へと力によって引き寄せられる試験粒子の雲／格子を考えるのである．
以下では重力による引力を仮定する．すなわち，試験粒子に働く力は参照点への距離ベクトルと同一直線上にあり，その大きさは距離の二乗に反比例するものである．各粒子について， 所定時間後の変形／偏向を得るために運動方程式を解くのである．これは大まかな初稿である．”
関数
getDeflection
は，基準点に向かう重力的な引力の下で試験粒子の新たな位置を計算するものである．これには，運動方程式を指定された時間まで，あるいは基準点への距離が閾値を下回るまで積分するために
NDSolveValue
を用いる．重力による偏向を考慮した後の位置を返し，空間に対する重力の作用のシミュレーションを行うものである．
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)​​]
関数
generateCube
は立方体構造を形成する三次元の格子線を生成するものであり，データセットと任意の細分化パラメータを受け取り，
Line
オブジェクトを用いて立方体の辺を構成する．各辺は細分化レベルに基づいてより小さな区間へと分割され，精緻な立方体表現が得られる．
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 ;;]]}]]​​]
関数
deformCube
は，重力による変形を模擬するために立方体の既存の線分を修正するものである．この関数は，
getDeflection
関数を適用することで点の新たな位置を計算し，これらの新しい位置を用いて線分を更新するのである．また，変形の程度に基づく色の調整を伴いながら
Graphics3D
を用いて変形を可視化するのである．
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]​​]
立方体の格子は点の表を用いて生成され，各辺をより小さな区分に細分することで精細な構造が形成される．
In[]:=
cube = generateCube[Table[{i, j, k}, ​​ {i, Subdivide[-1, 1, 3]}, ​​ {j, Subdivide[-1, 1, 3]}, ​​ {k, Subdivide[-1, 1, 3]}], 10];
重力による力の下で立方体が変形する様子を示す画像のシーケンスが生成される．各画像は重力源の異なる位置に対応し，変形は調整された色彩と照明によって可視化される．
In[]:=
imgs = Table[​​ deformCube[cube, 2/3*{Sin[x], Cos[x], 0}, 0.3, 1.8, Boxed -> False,​​ Background -> Black, Lighting -> "Neutral", ​​ ViewPoint -> {2, 2, 1},ImageSize->550, PlotLabel->​​ Framed[Style["Gravity Space Deformation",33,GrayLevel[.7],FontFamily->"Copperplate"],​​ FrameStyle->Black,FrameMargins11]], ​​{x, 0, 2 π, 2π/5}];
画像のシーケンスを示すインタラクティブな表示が作成される．この表示は，シーケンス内の位置を制御するパラメータを調整することで，重力による立方体の変形を探索することを可能にする．
In[]:=
Manipulate[imgs[[k]],{k,1,Length[imgs],1},SaveDefinitions->True]
Out[]=
​
k
アニメーション 化した.GiF にエキスポートする:
In[]:=
Export["grav.gif",imgs,ImageSize->550,"DisplayDurations"->.03]
Out[]=
grav.gif

このノートブックを引用する

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