## Unique Numbers Sequence Generator

MrSwiss
Posts: 3661
Joined: Jun 02, 2013 9:27
Location: Switzerland

### Unique Numbers Sequence Generator

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()

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    WendEnd SubSub 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)    NextEnd SubSub 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 IfEnd Sub' initialize randomizerRandomizeFor 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 limitsDim As ULong    elem = 16               ' number of array elementsDim As String   ans                     ' for Input's resultWhile 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 = "" : ClsWend' ===== 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    WendEnd SubSub 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)    NextEnd SubSub 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 IfEnd Sub' initialize randomizerRandomizeFor 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 requiredDim As ULong    elem = 6                ' number of array elements <-- as aboveDim As String   ans                     ' for Input's resultWhile 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 = "" : ClsWend' ===== END-DEMO2 ===== ' ----- EOF -----`
Provoni
Posts: 393
Joined: Jan 05, 2014 12:33
Location: Belgium

### Re: Unique Numbers Sequence Generator

Is it similar to this snippet?

Code: Select all

`screenres 640,480,32dim as integer i,low=32,high=64,l=high-low,array(l)for i=low to high   array(i-low)=inext irandomize timerfor i=0 to l   swap array(int(rnd*l)),array(int(rnd*l))next ifor i=0 to l   print array(i); 'output random unique numbernext isleep`
dodicat
Posts: 6765
Joined: Jan 10, 2006 20:30
Location: Scotland

### Re: Unique Numbers Sequence Generator

Camelot lottery.
(convoluted method to test gas64)

Code: Select all

`Type number    As Long n    As Long colEnd 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=clrNext#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,xFor n As Long=Lbound(a) To Ubound(a)    Color a(n).col    Print a(n).n;Iif(n<Ubound(a),",","");NextPrint#endmacro#macro check(a,b,x)x=0For 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 n2Next n1#endmacroRandomize Redim As number results(),choice()Dim As Long xScreen 20Do    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"        SleepLoop Until Inkey=Chr(27) `
MrSwiss
Posts: 3661
Joined: Jun 02, 2013 9:27
Location: Switzerland

### Re: Unique Numbers Sequence Generator

Provoni wrote: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.