長さを変えた15個の振り子を一斉に揺らす実験(動画)をMathematicaでシミュレートする。
2次元
3次元
手順は以下のとおり。
- 運動方程式の確認(g=1、m=1、糸はたるまないことを仮定)
- 1分間の振動数が整数になるような振り子の長さを求める
- 運動方程式を解いて結果をアニメーションにする
ラグランジの運動方程式は次のように確認できる。
lagrangian = (r \[Theta]'[t] )^2/2 - r Cos[\[Theta][t]]; D[D[lagrangian, \[Theta]'[t]], t] + D[lagrangian, \[Theta][t]] r Sin[theta[t]] + r^2 theta''[t]
これを使って、シミュレーションを作る。
(* 1分間の振動数が整数になる長さを求める *) tMax = 60; (* maximum time *) n = 15; (* number of objects *) theta = Table[Unique[], {n}]; initialAngle = Pi/6; r = Table[ First[x /. Solve[ tMax/(4 Sqrt[x] EllipticK[Sin[initialAngle/2]^2]) == (20 + i), x] ], {i, 1, n}]; (* 運動方程式を解く *) equations = Flatten[Table[{ (* ラグランジの運動方程式 *) r[[i]] Sin[theta[[i]][t]] + r[[i]]^2 theta[[i]]''[t] == 0, theta[[i]][0] == Pi/6, theta[[i]]'[0] == 0}, {i, 1, n}]]; solution = NDSolve[equations, theta, {t, 0, 1.1 tMax}]; (* 2次元アニメーション *) Animate[ points = Table[First[ {r[[i]] Sin[theta[[i]][t]], -r[[i]] Cos[theta[[i]][t]]} /. solution /. t -> T], {i, 1, n}]; Graphics[{ Black, Disk[#, 0.005], Gray, Line[{{0, 0}, #}]} & /@ points, PlotRange -> {{-0.8 Max[r], 0.8 Max[r]}, {0, -1.1 Max[r]}}], {T, 0, 1.1 tMax}, DefaultDuration -> 1.1 tMax, SaveDefinitions -> True]
実行結果は冒頭の動画の通り。
最後の部分を次のようにすれば3次元になる。
(* 3次元アニメーション *) Animate[ points = Table[First[ {i Max@r/n, r[[i]] Sin[theta[[i]][t]], -r[[i]] Cos[theta[[i]][t]]} /. solution /. t -> T], {i, 1, n}]; Graphics3D[{ Black, Sphere[#, 0.005], Gray, Line[{{#[[1]], 0, 0}, #}]} & /@ points, PlotRange -> {{0, 1.1 Max@r}, {-0.7 Max@r, 0.7 Max@r}, {0, -1.1 Max@r}}], {T, 0, 1.1 tMax}, DefaultDuration -> 1.1 tMax, SaveDefinitions -> True]