I was trying to simulate the 649 lottery draw using VBA subroutine. For the lottery draw, six balls will be selected by ball machine, in the beginning there are 49 balls, each with a 1/49 probability of being selected, and after the first ball was selected, the rest 48 balls will then each have a 1/48 probability of being selected, and so on.
There is no direct VBA function to generate random numbers such that the interval is not consecutive; for instance, the first number selected is 3, and for the second number selection, 3 will not be available! So computer has to choose from 1, 2, 4, ..., 49.
Below is a subroutine I wrote, basically I used Int((UBound(array) - 1 + 1) * Rnd + 1) to first generate random number between integer intervals, but I treat the random number only as index; for example, for the second number selection where I have the above 48 number left: 1, 2, 4, ..., 49, now if the random number is 3 (chosen from between 1 to 48), I actually get 4 for the second number selection because it's the 3rd in the list. And Rnd() provides draw from uniform distribution, so each number is equally likely. This is the method I use to get around.
Then I record all previous selected numbers into s1 to s6, and then make them non-repetitive in the subsequent number selection.
At last I sort using a quicksort algorithm found at VBA array sort function? with slight modification to the input array. And output results on an empty worksheet.
I also used Randomize to increase randomness. So everything seems good, I'm mimicking exactly the ball machine does: select the first number, then the second... and at last the sixth, without putting back (non-repetitive), the only difference I think would be ball machine is True random number, whereas VBA is Pseudo random number.
To my surprise, for 100,000 simulations, I used the Remove Duplicates and then 79994 duplicate values found and removed; 20006 unique values remain. Now I feel it is not reliable. How could most draws have duplicates? Tried many time but same thing, lots of duplicates. I'm not sure where has gone wrong, if something wrong with this design and logic, or it's just because Pseudo random number? Thank you all!
Here is my code:
Public k As Long
Sub RNG()
Dim NUMBER(), SELECTION(1 To 100000, 1 To 6)
Dim i As Integer, j As Integer, n As Integer
Dim s1 As Integer, s2 As Integer, s3 As Integer, s4 As Integer, s5 As Integer, s6 As Integer
For k = 1 To 100000
Erase NUMBER
ReDim NUMBER(1 To 49)
For i = 1 To 49
NUMBER(i) = i
Next i
For j = 1 To 6
'generate random number as index and select number based on index
Randomize
random_number = Int((UBound(NUMBER) - 1 + 1) * Rnd + 1)
SELECTION(k, j) = NUMBER(random_number)
'record each selection
Select Case j
Case Is = 1
s1 = SELECTION(k, j)
Case Is = 2
s2 = SELECTION(k, j)
Case Is = 3
s3 = SELECTION(k, j)
Case Is = 4
s4 = SELECTION(k, j)
Case Is = 5
s5 = SELECTION(k, j)
Case Is = 6
s6 = SELECTION(k, j)
End Select
'recreate number 1 to 49 by excluding already-selected numbers
Erase NUMBER
ReDim NUMBER(1 To 49 - j)
n = 0
For i = 1 To 49
Select Case j
Case Is = 1
If i <> s1 Then
n = n + 1
NUMBER(n) = i
End If
Case Is = 2
If i <> s1 And i <> s2 Then
n = n + 1
NUMBER(n) = i
End If
Case Is = 3
If i <> s1 And i <> s2 And i <> s3 Then
n = n + 1
NUMBER(n) = i
End If
Case Is = 4
If i <> s1 And i <> s2 And i <> s3 And i <> s4 Then
n = n + 1
NUMBER(n) = i
End If
Case Is = 5
If i <> s1 And i <> s2 And i <> s3 And i <> s4 And i <> s5 Then
n = n + 1
NUMBER(n) = i
End If
End Select
Next i
Next j
Call QuickSort(SELECTION, 1, 6)
Next k
Range("A1:F" & k - 1).Value = SELECTION
End Sub
Public Sub QuickSort(vArray As Variant, inLow As Long, inHi As Long)
'https://stackoverflow.com/questions/152319/vba-array-sort-function
Dim pivot As Variant
Dim tmpSwap As Variant
Dim tmpLow As Long
Dim tmpHi As Long
tmpLow = inLow
tmpHi = inHi
pivot = vArray(k, (inLow + inHi) \ 2)
While (tmpLow <= tmpHi)
While (vArray(k, tmpLow) < pivot And tmpLow < inHi)
tmpLow = tmpLow + 1
Wend
While (pivot < vArray(k, tmpHi) And tmpHi > inLow)
tmpHi = tmpHi - 1
Wend
If (tmpLow <= tmpHi) Then
tmpSwap = vArray(k, tmpLow)
vArray(k, tmpLow) = vArray(k, tmpHi)
vArray(k, tmpHi) = tmpSwap
tmpLow = tmpLow + 1
tmpHi = tmpHi - 1
End If
Wend
If (inLow < tmpHi) Then QuickSort vArray, inLow, tmpHi
If (tmpLow < inHi) Then QuickSort vArray, tmpLow, inHi
End Sub
Aucun commentaire:
Enregistrer un commentaire