mercredi 27 février 2019

Questions when trying to simulate lottery draws (draw numbers without putting back) using Excel VBA

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