Generating Long Sequences of Unique Numbers
Sometimes it is very useful to be able to generate a long sequence of unique numbers.
This tip provides a method to generate long sequences which are not consecutive by using a
shift register approach.
As well as providing a sequence of widely spaced unique numbers, the code also
generates a bit stream which can be used as a random bit generator, yielding an
equally probable but suitably "random" stream of 0s and 1s.
To try it out, start a new project. Then add a module and copy the following code into it:
Public Power2(0 To 31) As Long
Private m_lPoly(0 To 31) As Long
Private m_lMask(0 To 31) As Long
Private m_lNum As Long
Private m_lLength As Long
Public Property Get Number() As Long
Number = m_lNum
End Property
Public Property Let Number(ByVal lNumber As Long)
' Equivalent to seed in random numbers
m_lNum = lNumber
End Property
Public Property Get SequenceLength() As Long
SequenceLength = m_lLength
End Property
Public Property Let SequenceLength(ByVal lLength As Long)
m_lLength = lLength
End Property
Public Function NextNumber() As Long
If m_lNum And Power2(m_lLength - 1) Then
m_lNum = m_lNum Xor (m_lPoly(m_lLength))
' Shift and put 1 into lowest order bit:
m_lNum = RShift(m_lNum, 1) Or 1
' Return lowest order bit:
NextNumber = 1
Else
' Shift and put 0 into lowest order bit:
m_lNum = RShift(m_lNum, 1)
' Return lowest order bit:
NextNumber = 0
End If
' Mask out > bits
m_lNum = m_lNum And m_lMask(m_lLength)
End Function
Public Function RShift(ByVal lThis As Long, ByVal lBits As Long) As Long
If (lBits <= 0) Then
RShift = lThis
ElseIf (lBits > 63) Then
' .. error ...
ElseIf (lBits > 31) Then
RShift = 0
Else
If (lThis And Power2(31 - lBits)) = Power2(31 - lBits) Then
RShift = (lThis And (Power2(31 - lBits) - 1)) * Power2(lBits) Or Power2(31)
Else
RShift = (lThis And (Power2(31 - lBits) - 1)) * Power2(lBits)
End If
End If
End Function
Public Sub Init()
Power2(0) = &H1&
Power2(1) = &H2&
Power2(2) = &H4&
Power2(3) = &H8&
Power2(4) = &H10&
Power2(5) = &H20&
Power2(6) = &H40&
Power2(7) = &H80&
Power2(8) = &H100&
Power2(9) = &H200&
Power2(10) = &H400&
Power2(11) = &H800&
Power2(12) = &H1000&
Power2(13) = &H2000&
Power2(14) = &H4000&
Power2(15) = &H8000&
Power2(16) = &H10000
Power2(17) = &H20000
Power2(18) = &H40000
Power2(19) = &H80000
Power2(20) = &H100000
Power2(21) = &H200000
Power2(22) = &H400000
Power2(23) = &H800000
Power2(24) = &H1000000
Power2(25) = &H2000000
Power2(26) = &H4000000
Power2(27) = &H8000000
Power2(28) = &H10000000
Power2(29) = &H20000000
Power2(30) = &H40000000
Power2(31) = &H80000000
' Mod2 Polynomials for maximal length sequences:
m_lPoly(1) = 0
m_lPoly(2) = Power2(0)
m_lPoly(3) = Power2(0)
m_lPoly(4) = Power2(0)
m_lPoly(5) = Power2(1)
m_lPoly(6) = Power2(0)
m_lPoly(7) = Power2(0)
m_lPoly(8) = Power2(3) Or Power2(2) Or Power2(1)
m_lPoly(9) = Power2(3)
m_lPoly(10) = Power2(2)
m_lPoly(11) = Power2(1)
m_lPoly(12) = Power2(5) Or Power2(3) Or Power2(0)
m_lPoly(13) = Power2(3) Or Power2(2) Or Power2(0)
m_lPoly(14) = Power2(4) Or Power2(2) Or Power2(0)
m_lPoly(15) = Power2(0)
m_lPoly(16) = Power2(4) Or Power2(2) Or Power2(1)
m_lPoly(17) = Power2(2)
m_lPoly(18) = Power2(4) Or Power2(1) Or Power2(0)
m_lPoly(19) = Power2(4) Or Power2(1) Or Power2(0)
m_lPoly(20) = Power2(2)
m_lPoly(22) = Power2(0)
m_lPoly(23) = Power2(4)
m_lPoly(24) = Power2(3) Or Power2(2) Or Power2(0)
m_lPoly(25) = Power2(2)
m_lPoly(26) = Power2(5) Or Power2(1) Or Power2(0)
m_lPoly(27) = Power2(4) Or Power2(1) Or Power2(0)
m_lPoly(28) = Power2(2)
m_lPoly(29) = Power2(1)
m_lPoly(30) = Power2(5) Or Power2(3) Or Power2(0)
m_lPoly(31) = Power2(2)
'm_lPoly(32) = Power2(6) Or Power2(4) Or Power2(2) Or Power2(1) Or Power2(0)
' Masks:
Dim i As Long
For i = 0 To 30
m_lMask(i) = Power2(i) - 1
Next i
m_lMask(31) = &H7FFFFFFF
m_lNum = 1
End Sub
To test this function out, add a CommandButton and a ListBox to the project's form.
Set the Sorted property of the ListBox to True. Then add the following code:
Private Sub TestSequence(ByVal lLength As Long)
Dim i As Long
' Seed at 1:
Number = 1
' Set a sequence length:
SequenceLength = lLength
' Show that the algorithm generates
' unique digits 2^Length-1:
lstTest.Clear
lstTest.AddItem Number
For i = 1 To Power2(lLength) - 2 NextNumber
lstTest.AddItem Number
Next i
For i = 0 To lstTest.ListCount - 2
If lstTest.List(i) = lstTest.List(i + 1) Then
' Does not occur!
lstTest.ListIndex = i
MsgBox "Duplicate: " & lstTest.List(i)
End If
Next i
End Sub
Private Sub Command1_Click()
' Test a 255 number sequence (2^8-1):
TestSequence 8
End Sub
Private Sub Form_Load()
' Must initialise to set up the precompiled Powers of 2
' and polynomials:
Init
End Sub
Run the project. When you click the button, the list box will be filled with the
sequence of 255 numbers. Because the ListBox is sorted, the numbers will appear in order - this is
just to make the duplicate test simple.
To see the numbers in the sequence they are generated, change the ListBox's
Sorted property to False and re-run the project.
To check out the random bits generated by the routine, modify the line
NextNumber
To read:
If NextNumber = 0 Then
Debug.Print "Tails"
Else
Debug.Print "Heads"
End If
This will then display a random sequence of Heads and Tails.
|