09
Jul
05

3D Collisions

Here is a box of frictionless bouncy balls with gravity. The balls don’t rotate and never stop bouncing because there is no friction. This simulation uses the same basic code as the pool table simulation.

```(* runtime : 52 seconds *) << Graphics`Shapes`; g = {0, 0, -9.80665}; xmax = 1; Normalize[p_] := p/Sqrt[p.p]; Distance[p1_, p2_] := Sqrt[(p2 - p1).(p2 - p1)]; Move[{p_, v_}, t_] := {g t^2/2 + v t + p,g t + v}; Interpolate[t_, x1_, x2_] := (1 - t)x1 + t x2; Step[dt_] := Module[{balls2 = Table[{pa1, va1} = balls[[i]]; {pa2, va2} = Move[{pa1, va1}, dt]; result = {pa2, va2}; tmin = Infinity; Do[If[j != i, {pb1, vb1} = balls[[j]]; {pb2, vb2} = Move[{pb1, vb1}, dt]; p1 = pa1 - pb1; p2 = pa2 - pb2; p = p1 - p2; a = p.p; b = -2p1.p;c = p1.p1 - (2r)^2; d = b^2 - 4a c; If[d >= 0, If[a == 0, t = If[b == 0, 1, -c/b], t = (-b + {1, -1}Sqrt[d])/(2a); t = If[0 <= Min[t] <= 1, Min[t], t[[If[0 <= t[[1]] <= 1, 1, 2]]]]]; If[0 <= t <= 1 &&t < tmin, tmin = t; pa = Interpolate[t, pa1, pa2]; pb =Interpolate[t, pb1, pb2]; va = Interpolate[t, va1, va2]; vb = Interpolate[t, vb1, vb2]; normal = Normalize[pa - pb]; va -= (va - vb).normal normal;result = Move[{pa, va}, (1 - t)dt]]]], {j, 1, n}];Do[If[va1[[dim]] != 0, Scan[Module[{t = (#(xmax - r) - pa1[[dim]])/(va1[[dim]]dt)}, If[0 <= t <= 1 && t < tmin, tmin = t;pa = Interpolate[t, pa1, pa2]; va = Interpolate[t, va1, va2]; va[[dim]] = -va[[dim]];result = Move[{pa, va}, (1 - t)dt]]] &, {-1, 1}]], {dim, 1, 3}]; result, {i, 1, n}]},collision = False; Do[pa2 = balls2[[i, 1]]; If[Min[pa2] < -(xmax - r) || Max[pa2] > xmax -r, collision = True]; Do[If[Distance[balls2[[j, 1]], pa2] < 2r, collision = True], {j, i + 1, n}], {i, 1, n}]; If[collision, Do[Step[dt/2], {2}], balls = balls2]]; r = 0.25; n = 20; balls = {}; SeedRandom[0]; Do[start = True; While[start || Or @@ Map[Distance[p, #[[1]]] < 2r &, balls], start = False; p = (xmax - r)Table[2 Random[] - 1, {3}]];balls = Append[balls, {p, {0, 0, 0}}], {n}]; Do[Step[0.05]; Show[Graphics3D[{EdgeForm[], Map[TranslateShape[Sphere[r, 10, 6], #[[1]]] &, balls]}, PlotRange -> xmax{{-1, 1}, {-1, 1}, {-1, 1}}]], {50}];```

Advertisements

0 Responses to “3D Collisions”

1. Leave a Comment

Welcome !

You will find here some of my favorite hobbies and interests, especially science and art.

I hope you enjoy it!

Subscribe to the RSS feed to stay informed when I publish something new here.

I would love to hear from you! Please feel free to send me an email : bugman123-at-gmail-dot-com

• 555,424 hits
Advertisements