I'm trying to write a function that changes 3 coordinates and 3 velocities in a loop using random numbers. Although he generated numbers seem random enough. The two last values never drift apart, while the first one does go its own way.
This is the function, I will also link the excel workbook, so you can see it in action (it's a animated colorbox using RGB and sliders for the values. Just run the 'color' sub
Function variate(ByRef x_origin As Double, ByRef y_origin As Double, ByRef offset_x As Double, ByRef offset_y As Double, Optional ByRef z_origin As Double, Optional ByRef offset_z As Double, Optional xyz_bounds) As Variant
'this function adds random number to each of the origins
'the offset is the 'drift' the object has (or velocity)
'calculate a random number
'if the number is going in the same direction, speed up
'otherwise slow down
Dim new_origin_x As Double
Dim new_origin_y As Double
Dim new_origin_z As Double
Dim velocity_x As Double
Dim velocity_y As Double
Dim velocity_z As Double
Dim speed_x As Double
Dim speed_y As Double
Dim speed_z As Double
Dim random_number_x As Double
Dim random_number_y As Double
Dim random_number_z As Double
Dim random_speed_x As Double
Dim random_speed_y As Double
Dim random_speed_z As Double
'calculate a random with the seed and make it between -0.5 and 0.5
Randomize
random_number_x = Rnd(Range("x_fact").Value) - 0.5
Randomize
random_number_y = Rnd(Range("y_fact").Value) - 0.5
Randomize
random_number_z = Rnd(Range("z_fact").Value) - 0.5
'for the speed
Randomize
random_speed_x = Rnd(1) - 0.5
Randomize
random_speed_y = Rnd(1) - 0.5
Randomize
random_speed_z = Rnd(1) - 0.5
'see how much there is a speed up
'what point would we be at with the current speed
'that is the distance travelled in time, but the time is 1 'unit' ...
'and let's add some randohohomnessss
speed_x = offset_x + (random_speed_x / Range("x_rem").Value)
speed_y = offset_y + (random_speed_y / Range("y_rem").Value)
speed_z = offset_z + (random_speed_z / Range("z_rem").Value)
'so new origin is new_origin_x = x_origin + offset_x
'but than we've travelled at the same speed, with directional changes
'we're probably not even moving
'so add some randomness to act as 'live'
new_origin_x = x_origin + offset_x + (random_number_x / Range("x_fact").Value)
new_origin_y = y_origin + offset_y + (random_number_y / Range("y_fact").Value)
new_origin_z = y_origin + offset_z + (random_number_z / Range("z_fact").Value)
'variate = [{new_origin_x;new_origin_y};{speed_x;speed_y}]
'variate = [{new_origin_x;new_origin_z};{speed_x;speed_z}]
'see if boundaries are requested and if so, not met
'should be: going to meet at the current speed
If Not IsMissing(xyz_bounds) Then
Dim distant_from_bounds_x
Dim distant_from_bounds_y
Dim distant_from_bounds_z
Dim future_pos_x
Dim previous_dist_x
Dim previous_dist_y
Dim previous_dist_z
future_pos_x = new_origin_x + 3 * speed_x
Dim future_pos_y
future_pos_y = new_origin_y + 3 * speed_y
Dim future_pos_z
future_pos_z = new_origin_z + 3 * speed_z
distant_from_bounds_x = xyz_bounds / 2 - Abs(future_pos_x - xyz_bounds / 2)
distant_from_bounds_y = xyz_bounds / 2 - Abs(future_pos_y - xyz_bounds / 2)
distant_from_bounds_z = xyz_bounds / 2 - Abs(future_pos_z - xyz_bounds / 2)
previous_dist_x = xyz_bounds / 2 - Abs((x_origin + 3 * speed_x) - xyz_bounds / 2)
previous_dist_y = xyz_bounds / 2 - Abs((y_origin + 3 * speed_y) - xyz_bounds / 2)
previous_dist_z = xyz_bounds / 2 - Abs((z_origin + 3 * speed_z) - xyz_bounds / 2)
'slow down
If (distant_from_bounds_x < 10) And (distant_from_bounds_x - previous_dist_x < 0) Then
speed_x = speed_x - speed_x / 3
If Abs(speed_x) < 1.5 Then speed_x = -speed_x * 2.9
End If
If distant_from_bounds_y < 10 And (distant_from_bounds_y - previous_dist_y < 0) Then
speed_y = speed_y - speed_y / 3
If Abs(speed_y) < 1.5 Then speed_y = -speed_y * 2.9
End If
If distant_from_bounds_z < 10 And (distant_from_bounds_z - previous_dist_z < 0) Then
speed_z = speed_z - speed_z / 3
If Abs(speed_z) < 1.5 Then speed_z = -speed_z * 2.9
End If
'speedlimits
If Abs(speed_x) > 9 Then speed_x = speed_x - Abs(speed_x / 4)
If Abs(speed_y) > 9 Then speed_y = speed_y - Abs(speed_y / 4)
If Abs(speed_z) > 9 Then speed_z = speed_z - Abs(speed_z / 4)
End If
'return the values and the new velocity to add some more stuff
x_origin = new_origin_x
y_origin = new_origin_y
z_origin = new_origin_z
offset_x = speed_x
offset_y = speed_y
offset_z = speed_z
End Function
Any suggestions would be greatly appreciated !
If you can excuse my abrasiveness, you are misusing the generator:
1) At the beginning of your function, include the line
Rnd(-1)
That is how you seed the generator.
2) Remove all your Randomize calls as they are ruining the statistical properties of the generator. I think that is the cause of your problems. You can have one Randomize call directly after Rnd(-1) above, but I think it's nice to have the same sequence generated for tractability.
3) There is no need to have a parameter in your Rnd() calls (other than the first step), as the default behaviour is to return a number in the range [0, 1). In fact this could be causing your problems, since a negative parameter value re-seeds the generator!
4) Investigate the effects of doing the above. But be aware that the VBA random sequence is a linear congruential generator of the form next = ((c * prev) mod b) + a where a, b and c are constants, prev is the previous random number and next the generated one. (As a final flourish, the integer values next and prev are scaled to floating point numbers). You can see that there is possible autocorrelation in the sequence since when prev is small, the modulus will have no effect. You can but hope that the engineers at Microsoft have assigned a large value to c to circumvent this effect. This autocorrelation can cause "sticking" when using random numbers in a multidimensional situation.
(4) could therefore be causing your problem, and if it is, you need to switch to another generator. Let me know and we can make some suggestions on that front.
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With