[VB6] - Lottery-Algorithm

[Zvoni]

On a german Forum I developed the following Lottery-Algorithm (which i haven't found on the Internet in this form).

I would like to hear your opinions and/or suggestions to improve it

Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
 
Sub Lottery(ByVal DrawNumbers As Long, ByVal TotalNumbers As Long)
Dim arrSource() As Long    
Dim arrDest() As Long
 
Dim i As Long
Dim j As Long
Dim Counter As Long
Dim RandomNumber As Long
 
    'What Lottery is played
    ReDim arrDest(1 To DrawNumbers)
    ReDim arrSource(1 To TotalNumbers)
    
    'Create Source-Array
    For i = 1 To TotalNumbers
    
        arrSource(i) = i
    
    Next
    
    Counter = 0
 
    Randomize
 
    Do
 
        RandomNumber = Int(UBound(arrSource) * Rnd + 1)
    
        Counter = Counter + 1
        arrDest(Counter) = arrSource(RandomNumber)
        
        'Cutting out the RandomNumber drawn
        For j = RandomNumber + 1 To UBound(arrSource)
        
            CopyMemory arrSource(j - 1), arrSource(j), 4
            
        Next
        
        'Cut down the Source-Array
        ReDim Preserve arrSource(1 To UBound(arrSource) - 1)
           
    Loop Until Counter = DrawNumbers
    
    For i=1 to DrawNumbers
     
         Debug.Print arrDest(i)
 
    Next
 
End Sub
 
'Calling the function with
Call Lottery (6, 49)

[si_the_geek]

That is generally good, but there are a couple of relatively minor issues.

While CopyMemory has its uses, moving one Long (even if done 49*6 times in total) is not worth it - the overhead of calling an API outweighs the speed benefit.

On a semi-related note, ReDim Preserve is one of the slowest things you can do, so if you care about speed, try to avoid it. One way is to use a variable to indicate the "ubound" position, and when you want to remove an item just move the item at "ubound" to it, then decrease the "ubound" variable. In cases like this one (where you create the array only to add/remove items), a Collection may be a better idea.

[Zvoni]

That is generally good, but there are a couple of relatively minor issues.

While CopyMemory has its uses, moving one Long (even if done 49*6 times in total) is not worth it - the overhead of calling an API outweighs the speed benefit.

On a semi-related note, ReDim Preserve is one of the slowest things you can do, so if you care about speed, try to avoid it. One way is to use a variable to indicate the "ubound" position, and when you want to remove an item just move the item at "ubound" to it, then decrease the "ubound" variable. In cases like this one (where you create the array only to add/remove items), a Collection may be a better idea.

Hi Si,

thx for the idea.

You mean something like this?

Sub Lottery(ByVal DrawNumbers As Long, ByVal TotalNumbers As Long)
    Dim arrSource() As Long
    Dim arrDest() As Long
     
    Dim i As Long
    Dim UpperBound As Long
    Dim Counter As Long
    Dim RandomNumber As Long
     
        'What Lottery is played
        ReDim arrDest(1 To DrawNumbers)
        ReDim arrSource(1 To TotalNumbers)
       
        'Create Source-Array
        For i = 1 To TotalNumbers
       
            arrSource(i) = i
       
        Next
       
        Counter = 0
        UpperBound = TotalNumbers
 
        Randomize
     
        Do
     
            RandomNumber = Int(UpperBound * Rnd + 1)
       
            Counter = Counter + 1
            arrDest(Counter) = arrSource(RandomNumber)
           
            'Swapping the RandomNumber drawn with the Number at UpperBound
            arrSource(RandomNumber) = arrSource(UpperBound)
 
            UpperBound = UpperBound - 1
               
        Loop Until Counter = DrawNumbers
       
        For i = 1 To DrawNumbers
         
             Debug.Print arrDest(i)
     
        Next
     
    End Sub
    
 
    'Calling the function with
    Call Lottery(6, 49)

As for the Collection-Object: I plainly dislike it, and i wouldn't be able to give you a reason for it ....

[si_the_geek]

That's it.

I can understand not liking the Collection as it isn't great in terms of a general-purpose tool, but it does have its uses - and in situations like this it can often be quicker (but for such a small data set, that wont matter).