vbAccelerator - Contents of code file: cCellularRandom.cls

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "cCellularRandom"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

' Generates a sequence of heads/tails values using a class 30
' 1-dimensional cellular automata.
'
' This has been shown to produce demonstrably more random
' output that any of the shift register approaches normally used,
' in which clear patterns emerge when the numbers are plotted
' relative to the prior numbers in the sequence.
'

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
    lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)

Private m_lSize As Long
Private m_cells() As Byte
Private m_iIndex As Long


Public Function nextRandom() As Boolean
   
   ' determine the index to write into
   Dim iNextIndex As Long
   If (m_iIndex = 1) Then
      iNextIndex = 0
   Else
      iNextIndex = 1
   End If
   
   ' Calculate the automata
   Dim i As Long
   Dim iPrev As Long
   Dim iNext As Long
   iPrev = m_lSize - 1
   For i = 0 To m_lSize - 1
      iNext = (i + 1) Mod m_lSize
      If (m_cells(m_iIndex, iPrev) = 0) Then
         ' output is white if me or next is black:
         If (m_cells(m_iIndex, i) = 0) Or (m_cells(m_iIndex, iNext) = 0) Then
            m_cells(iNextIndex, i) = 1
         Else
            m_cells(iNextIndex, i) = 0
         End If
      Else
         ' output is black if me or next is black:
         If (m_cells(m_iIndex, i) = 0) Or (m_cells(m_iIndex, iNext) = 0) Then
            m_cells(iNextIndex, i) = 0
         Else
            m_cells(iNextIndex, i) = 1
         End If
      End If
      
      iPrev = i
   Next i
         
   m_iIndex = iNextIndex
   nextRandom = m_cells(iNextIndex, m_lSize \ 2)
   
End Function

Public Sub Seed(ByVal fSeed As Long)
   
   ' determine the index to write into
   Dim iNextIndex As Long
   If (m_iIndex = 1) Then
      iNextIndex = 0
   Else
      iNextIndex = 1
   End If

   ' write the bits:
   Dim lCentre As Long
   lCentre = m_lSize \ 2
   Dim i As Long
   Dim j As Long
   Dim pow As Long
   pow = 1
   j = lCentre - 16
   For i = 0 To 31
      If (j >= 0) And (j < m_lSize) Then
         m_cells(iNextIndex, j) = ((fSeed And pow) = pow)
      End If
      j = j + 1
      If (i >= 30) Then
         pow = &H80000000
      Else
         pow = pow * 2
      End If
   Next i
   
   m_iIndex = iNextIndex

End Sub

Public Sub SeedLarge(b() As Byte)

   ' determine the index to write into
   Dim iNextIndex As Long
   If (m_iIndex = 1) Then
      iNextIndex = 0
   Else
      iNextIndex = 1
   End If

   Dim lSeedSize As Long
   lSeedSize = UBound(b) - LBound(b) + 1
   
   Dim j As Long
   For j = 0 To lSeedSize - 1
      m_cells(iNextIndex, j) = IIf(b(j + LBound(b)) > 0, 1, 0)
      If (j > m_lSize) Then
         Exit For
      End If
   Next j
   
   m_iIndex = iNextIndex
   
End Sub

Private Sub Class_Initialize()
   m_lSize = 200
   ReDim m_cells(0 To 1, 0 To m_lSize - 1) As Byte
   m_iIndex = 0
   ' seed the initial state
   m_cells(m_iIndex, m_lSize \ 2) = 1
End Sub


' Evolution of the automata over a small number of generations.
' Regular patterns occur on the right hand side but the sequence
' of items down the centre line has been shown to be
' statistically random.
'
'                                0
'                               000
'                              00  0
'                             00 0000
'                            00  0   0
'                           00 0000 000
'                          00  0    0  0
'                         00 0000  000000
'                        00  0   000     0
'                       00 0000 00  0   000
'                      00  0    0 0000 00  0
'                     00 0000  00 0    0 0000
'                    00  0   000  00  00 0   0
'                   00 0000 00  000 000  00 000
'                  00  0    0 000   0  000  0  0
'                 00 0000  00 0  0 00000  0000000
'                00  0   000  0000 0    000      0
'               00 0000 00  000    00  00  0    000
'              00  0    0 000  0  00 000 0000  00  0
'             00 0000  00 0  000000  0   0   000 0000
'            00  0   000  0000     0000 000 00   0   0
'           00 0000 00  000   0   00    0   0 0 000 000
'          00  0    0 000  0 000 00 0  000 00 0 0   0  0
'         00 0000  00 0  000 0   0  0000   0  0 00 000000
'        00  0   000  0000   00 00000   0 00000 0  0     0
'       00 0000 00  000   0 00  0    0 00 0     00000   000
'      00  0    0 000  0 00 0 0000  00 0  00   00    0 00  0
'     00 0000  00 0  000 0  0 0   000  0000 0 00 0  00 0 0000
'    00  0   000  0000   0000 00 00  000    0 0  0000  0 0   0
'   00 0000 00  000   0 00    0  0 000  0  00 0000   000 00 000
'  00  0    0 000  0 00 0 0  00000 0  000000  0   0 00   0  0  0
' 00 0000  00 0  000 0  0 0000     0000     0000 00 0 0 000000000
'00  0   000  0000   0000 0   0   00   0   00    0  0 0 0        0
'