Unique Numbers Sequence Generator

[MrSwiss]

The Sub GenInt32() is generating a set (or sequence) of unique numbers, in a
dynamically sized return-array, user set range/amount (default: ByRef passing).
The other two Sub's are simply needed to make sensible demo-programs:
Sub ArrCopy1D() and Sub ArrSort1D()

Read comments in code for more information ...

Demo1 -- using a negative to positive range (Long):

Code: Select all

' GenInt32_Sub-Demo1.bas -- (c) 2020-06-09, MrSwiss
'
' compile: -s console
'

Sub GenInt32( _                         ' unique whole numbers sequence generator
          a()   As Long, _              ' dynamic array is mandatory
    ByVal elem  As Long, _              ' number of array elements
    ByVal lol   As Long, _              ' lower range limit (inclusive)
    ByVal hil   As Long  _              ' upper range limit (inclusive)
    )
    #Define Lrng(l, h)  ( CLng(Int(Rnd() * ((h + 1) - (l)) + (l))) )
    ' check for user input errors and fix them (error correction code)
    If elem < 1  Then elem = 1          ' ECC: set minimal array size (crash prevention)
    If lol > hil Then Swap lol, hil     ' ECC: proper order of limits (for #Define)

    ReDim a(elem - 1)                   ' resize dynamic array (BASE 0)
    Dim As Long tmp = 0, idx = 1        ' local variables (preset)

    a(0) = Lrng(lol, hil)               ' assign first random value always
    While idx < elem                    ' run if array is not yet filled
        tmp = Lrng(lol, hil)            ' get random value (within specified range)
        For j As UInteger = 0 To idx    ' check result array for duplicates
            If a(j) = tmp Then Exit For ' if duplicate found, fetch new value
            If j = idx Then _           ' no duplicate but empty slot reached
                a(j) = tmp : idx += 1   ' assign value | increment idx
        Next
    Wend
End Sub

Sub ArrCopy1D( _                        ' size target and copy 1D-array
          src() As Const Long, _        ' source 'read only' array
          trg() As Long  _              ' target array, MUST be dynamic!
    )
    Dim As Integer  lb = LBound(src), _ ' temp. save src() bounds
                    ub = UBound(src)

    ReDim trg(lb To ub)                 ' size trg() equal to src()
    For i As Integer = lb To ub         
        trg(i) = src(i)                 ' deep copy (aka: element by element)
    Next
End Sub

Sub ArrSort1D( _                        ' sort 1D-array (any type of array)
          a()   As Long, _              ' array to be sorted
    ByVal d_up  As Boolean = TRUE _     ' default: small to large numbers _
    )                                   ' optional: FALSE = large to small ...
    Dim As Integer  lb = LBound(a), x, _' local variables _
                    ub = UBound(a), y   ' bounds & loop iterators

    If d_up Then                        ' default: small to large
        For y = lb To ub - 1
            For x = y + 1 To ub
                If a(x) < a(y) Then _
                    Swap a(x), a(y)
            Next
        Next
    Else                                ' optional: large to small
        For y = lb To ub - 1
            For x = y + 1 To ub
                If a(x) > a(y) Then _
                    Swap a(x), a(y)
            Next
        Next
    End If
End Sub


' initialize randomizer
Randomize

For h As UInteger = 0 To 999
    Rnd() : Rnd() : Rnd() : Rnd() : _
    Rnd() : Rnd() : Rnd() : Rnd()
Next
' end randomizer init

' ===== DEMO1 =====
Dim As Long     nSet(Any), sSetU(Any), _' one dimension, dynamic Long arrays _
                sSetD(Any), min = -75, max = 75 ' and, range limits
Dim As ULong    elem = 16               ' number of array elements
Dim As String   ans                     ' for Input's result

While TRUE                              ' endless loop, conditional exit
    While InKey() <> "" : Wend          ' clear keyboard buffer
    Print "number", "generated", "sort up", "sort down"
    Print
    ' generate the requested amount of unique numbers (within specified range)
    GenInt32(nSet(), elem, min, max)
    ' resize target array and copy whole content
    ArrCopy1D(nSet(), sSetU())
    ArrCopy1D(nSet(), sSetD())
    ' sort the arays (first: from smallest up, second: from lagest down)
    ArrSort1D(sSetU())
    ArrSort1D(sSetD(), FALSE)
    ' show results (of above operations)
    For i As Integer = LBound(nSet) To UBound(nSet)
        Print i + 1, nSet(i), sSetU(i), sSetD(i)
    Next

    Print : Print
    Input "use [q/Q] then [Enter] to END program: ", ans
    If Left(UCase(ans), 1) = "Q" Then Exit While
    ans = "" : Cls
Wend
' ===== END-DEMO1 ===== ' ----- EOF -----

Demo2 -- generating Lotto Numbers (positive only):

Code: Select all

' GenInt32_Sub-Demo2.bas -- (c) 2020-06-09, MrSwiss
'
' compile: -s console
'

Sub GenInt32( _                         ' unique whole numbers sequence generator
          a()   As Long, _              ' dynamic array is mandatory
    ByVal elem  As Long, _              ' number of array elements
    ByVal lol   As Long, _              ' lower range limit (inclusive)
    ByVal hil   As Long  _              ' upper range limit (inclusive)
    )
    #Define Lrng(l, h)  ( CLng(Int(Rnd() * ((h + 1) - (l)) + (l))) )
    ' check for user input errors and fix them (error correction code)
    If elem < 1  Then elem = 1          ' ECC: set minimal array size (crash prevention)
    If lol > hil Then Swap lol, hil     ' ECC: proper order of limits (for #Define)

    ReDim a(elem - 1)                   ' resize dynamic array (BASE 0)
    Dim As Long tmp = 0, idx = 1        ' local variables (preset)

    a(0) = Lrng(lol, hil)               ' assign first random value always
    While idx < elem                    ' run if array is not yet filled
        tmp = Lrng(lol, hil)            ' get random value (within specified range)
        For j As UInteger = 0 To idx    ' check result array for duplicates
            If a(j) = tmp Then Exit For ' if duplicate found, fetch new value
            If j = idx Then _           ' no duplicate but empty slot reached
                a(j) = tmp : idx += 1   ' assign value | increment idx
        Next
    Wend
End Sub

Sub ArrCopy1D( _                        ' size target and copy 1D-array
          src() As Const Long, _        ' source 'read only' array
          trg() As Long  _              ' target array, MUST be dynamic!
    )
    Dim As Integer  lb = LBound(src), _ ' temp. save src() bounds
                    ub = UBound(src)

    ReDim trg(lb To ub)                 ' size trg() equal to src()
    For i As Integer = lb To ub         
        trg(i) = src(i)                 ' deep copy (aka: element by element)
    Next
End Sub

Sub ArrSort1D( _                        ' sort 1D-array (any type of array)
          a()   As Long, _              ' array to be sorted
    ByVal d_up  As Boolean = TRUE _     ' default: small to large numbers _
    )                                   ' optional: FALSE = large to small ...
    Dim As Integer  lb = LBound(a), x, _' local variables _
                    ub = UBound(a), y   ' bounds & loop iterators

    If d_up Then                        ' default: small to large
        For y = lb To ub - 1
            For x = y + 1 To ub
                If a(x) < a(y) Then _
                    Swap a(x), a(y)
            Next
        Next
    Else                                ' optional: large to small
        For y = lb To ub - 1
            For x = y + 1 To ub
                If a(x) > a(y) Then _
                    Swap a(x), a(y)
            Next
        Next
    End If
End Sub


' initialize randomizer
Randomize

For h As UInteger = 0 To 999
    Rnd() : Rnd() : Rnd() : Rnd() : _
    Rnd() : Rnd() : Rnd() : Rnd()
Next
' end randomizer init

' ===== DEMO2-LottoNumbers =====
Dim As Long     nSet(Any), sSetU(Any), _' one dimension, dynamic Long arrays _
                min = 1, max = 45       ' and, range limits <-- adjust as required
Dim As ULong    elem = 6                ' number of array elements <-- as above
Dim As String   ans                     ' for Input's result

While TRUE                              ' endless loop, conditional exit
    While InKey() <> "" : Wend          ' clear keyboard buffer
    Print "Demo2 -- Lotto Numbers Generator ("; _
          Str(elem); " from "; Str(min); " to "; _
          Str(max); ")"
    Print String(49, "~")
    Print : Print "number", "generated", "sorted: up" : Print
    ' generate the requested amount of unique numbers (within specified range)
    GenInt32(nSet(), elem, min, max)
    ' resize target array and copy whole content
    ArrCopy1D(nSet(), sSetU())
    ' sort the aray default mode: lowest 'up' to largest
    ArrSort1D(sSetU())
    ' show results (of above operations)
    For i As Integer = LBound(nSet) To UBound(nSet)
        Print i + 1, nSet(i), sSetU(i)
    Next
    ' ask if user wants to quit
    Print : Print
    Input "use [q/Q] then [Enter] to END program: ", ans
    If Left(UCase(ans), 1) = "Q" Then Exit While
    ans = "" : Cls
Wend
' ===== END-DEMO2 ===== ' ----- EOF -----

[Provoni]

Is it similar to this snippet?

Code: Select all

screenres 640,480,32

dim as integer i,low=32,high=64,l=high-low,array(l)

for i=low to high
   array(i-low)=i
next i

randomize timer
for i=0 to l
   swap array(int(rnd*l)),array(int(rnd*l))
next i

for i=0 to l
   print array(i); 'output random unique number
next i

sleep


[dodicat]

Camelot lottery.
(convoluted method to test gas64)

Code: Select all


Type number
    As Long n
    As Long col
End Type


#macro arraydelete(a,position)
Scope
    Dim As Long index=position
    If index>=Lbound(a) And index<=Ubound(a) Then
        For x As Long=index To Ubound(a)-1
            a(x)=a(x+1)
        Next x
        Redim Preserve a(Lbound(a) To Ubound(a)-1)
    End If
End Scope
#endmacro

#define range(f,l) Int(Rnd*((l+1)-(f)))+(f)

#macro init(a,clr)
Redim  a(1 To 59)
For n As Long=Lbound(a) To Ubound(a)
    a(n).n=n
    a(n).col=clr
Next
#endmacro

#macro getsix(a,colour)
init(a,colour)
For n As Long=1 To 59-6
    Dim As Long r=range(Lbound(a),Ubound(a))
    arraydelete(a,r)
Next
#endmacro

#macro printout(a,y,x)
Locate y,x
For n As Long=Lbound(a) To Ubound(a)
    Color a(n).col
    Print a(n).n;Iif(n<Ubound(a),",","");
Next
Print
#endmacro


#macro check(a,b,x)
x=0
For n1 As Long=Lbound(a) To Ubound(a)-1
    For n2 As Long=n1+1 To Ubound(a)
        If a(n1).n = b(n2).n Then x+=1:a(n1).col=4:b(n2).col=4
    Next n2
Next n1
#endmacro


Randomize

Redim As number results(),choice()

Dim As Long x
Screen 20
Do
    Cls
    Color 7
    Print " results";Tab(32);"choice";Tab(60);"won"
    For n As Long=  2 To 45
        getsix(results,15)
        getsix(choice,3)
        check(results,choice,x)
        printout(results,n,2)
        printout(choice,n,30)
        Color 7
        Locate n,60 :Print Iif(x,Str(x),"")
    Next n
    Print
    Print "Press a key to refresh, <esc> to end"
   
    Sleep
Loop Until Inkey=Chr(27)
 

[MrSwiss]

Is it similar to this snippet?

How 'narrow' or 'wide' interpreted, do you want 'similar' to be ?

From my point of view, there isn't any similarity, because:

yours: static, in main-code (mine: flexible, a self-contained procedure)
yours: not reusable (mine: reusable, just copy & paste to any source file)
yours: Integer, variable size, depending on compiler's bitness (mine: Long, 32 bits always)

Just to put it into a nutshell.