I have a simulation of bouncing balls of different sizes in a Canvas. The properties of every ball is in a class Circle and I have an array of type Circle to store the whereabouts of the circles.
A timer controls the movement of the circles (velocity) and I check collisions of the circles via a math formula ( Collision Detection (jeffreythompson.org)). For a very smooth operation I use 20/1000 of a second as timer tick. The Canvas is repainted in this timer tick as well.
The collision detection uses 2 intertwined loops to check every circle against the position of every other circle. So amount of loops = circles^2. I noticed that lowering the timer interval to 1 does not really affect the speed as (I think) the loop cannot be completed within 1 timer tick with circles = 500. Any suggestions to speed up the algorithm?
Public Sub CheckCollision()
For i As Integer = 0 To UBound(Circles)
'Bounce away from Canvas edges
BoundariesCheck(Circles(i))
For j As Integer = i + 1 To UBound(Circles)
Dim dx As Double = Circles(j).x - Circles(i).x
Dim dy As Double = Circles(j).y - Circles(i).y
Dim distance As Double = Sqrt(dx * dx + dy * dy)
If distance <= (Circles(i).radius + Circles(j).radius) Then
'There is a collision as radius of both circles touch each other
'Update statistics
Collisions = Collisions + 1
Circles(i).HadCollisions = Circles(i).HadCollisions + 1
Circles(j).HadCollisions = Circles(j).HadCollisions + 1
'Calculate the angle of collision
Dim angle As Double = ATan2(dy, dx)
'Calculate the overlap distance
Dim overlap As Double = (Circles(i).radius + Circles(j).radius) - distance
'Move Circles apart based on the overlap
Circles(i).x = Circles(i).x - (overlap / 2) * Cos(angle)
Circles(i).y = Circles(i).y - (overlap / 2) * Sin(angle)
Circles(j).x = Circles(j).x + (overlap / 2) * Cos(angle)
Circles(j).y = Circles(j).y + (overlap / 2) * Sin(angle)
'Store current velocities
Dim v1x As Double = Circles(i).velocityX
Dim v1y As Double = Circles(i).velocityY
Dim v2x As Double = Circles(j).velocityX
Dim v2y As Double = Circles(j).velocityY
'Calculate the Masses based on radius (larger radius = greater Mass)
Dim Mass1 As Double = Circles(i).radius
Dim Mass2 As Double = Circles(j).radius
'Calculate new velocities based on Mass
Circles(i).velocityX = (Mass1 - Mass2) / (Mass1 + Mass2) * v1x + (2 * Mass2) / (Mass1 + Mass2) * v2x
Circles(i).velocityY = (Mass1 - Mass2) / (Mass1 + Mass2) * v1y + (2 * Mass2) / (Mass1 + Mass2) * v2y
Circles(j).velocityX = (2 * Mass1) / (Mass1 + Mass2) * v1x + (Mass2 - Mass1) / (Mass1 + Mass2) * v2x
Circles(j).velocityY = (2 * Mass1) / (Mass1 + Mass2) * v1y + (Mass2 - Mass1) / (Mass1 + Mass2) * v2y
'Ensure velocities are not too small
If Abs(Circles(i).velocityX) < 0.1 Then Circles(i).velocityX = 0.1 * Sgn(v1x)
If Abs(Circles(i).velocityY) < 0.1 Then Circles(i).velocityY = 0.1 * Sgn(v1y)
If Abs(Circles(j).velocityX) < 0.1 Then Circles(j).velocityX = 0.1 * Sgn(v2x)
If Abs(Circles(j).velocityY) < 0.1 Then Circles(j).velocityY = 0.1 * Sgn(v2y)
End If
Next
Next
End Sub
Put all “Dim” outside the loops.
Use variables to store intermediary calculations.
For example, you do 4 x “overlap / 2”, 2 x “Mass1 - Mass2” and 2 x “Mass2 - Mass1” = -(Mass1 - Mass2), 8 x “Mass1 + Mass2”, etc…
VoilĂ !
only a moving circle can collide with a neighboring.
you could reduce the collision test by putting them into a grid.
the step of movement i would add to the radius.
the result as move or not and a change in the direction / speed vector by impulse transfer.
physics can be calculated in a thread 1000 times per second.
make the draw separate for visible circles.
should be similar but distance value must be 1 or greater
direction.x = dx/distance
direction.y = dy/distance
the x,y result can be multiplied with a other value to move it along.
I did this fairly quickly, but the general idea should be correct.
1: the outer loop only has to count up to UBound(Circles)-1 rather thanUBound(Circles). This is a minor thing but still…
2: You can avoid doing two multiplications and a square root in most of the iterations by doing a rough worst case calculation first, and if the circles are obviously not close enough to be in collision, skip to the next loop iteration.
For i As Integer = 0 To UBound(Circles)-1 'Note the change in loop limit
'Bounce away from Canvas edges
BoundariesCheck(Circles(i))
For j As Integer = i + 1 To UBound(Circles)
Dim dx As Double = Circles(j).x - Circles(i).x
Dim dy As Double = Circles(j).y - Circles(i).y
Dim roughDist as Double = abs(dx) + abs(dy)
'Do a rough (worst case) distance calc avoiding multiplications and square root
if roughDist > (Circles(i).radius + Circles(j).radius) Then continue
Dim distance As Double = Sqrt(dx * dx + dy * dy)
.
.
.
You can have a look yourself if you want. This code is refactored with some of the remarks here. BouncingBallsWithMassVelocityOptimized.zip (15.9 KB) I think the movement and collisions are pretty smooth, but slow with balls >250 and higher timer ticks do not add to the speed anymore.
Check bounding boxes first, before doing any expensive math operations. You don’t have to get into any math if the circles are nowhere near each other.