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
3 posts - 3 participants