Attribute VB_Name = "basISAAC"
' ***************************************************************************
' Module:        basISAAC.bas
'
' Test PC is a 500 mhz Pentium III 256mb RAM.
'
' ISAAC Random number generator for Visual Basic 6.0 and VBA
' by Kenneth Ives  kenaso@tx.rr.com
'
' This code is Public Domain. You may use this code as you like.
' There are no guarantees.
'
' Original C code by Bob Jenkins, March 1996
' http://www.burtleburtle.net/bob/rand/isaacafa.html
' Bob Jenkins  bob_jenkins@burtleburtle.net
'
' ***************************************************************************
'
' ACKNOWLEDGEMENTS:
'
'  Thank you Bob Jenkins for making your ISAAC code available to the public.
'
'  Mark Hutchinson   aikimark@aol.com
'  His research on the correct use of reseeding the Microsoft Visual Basic
'  number generator.  See CreateSeed() routine.
'  http://www.15seconds.com/issue/051110.htm
'
'  Pablo Mariano Ronchi  pmronchi@yahoo.com.ar translated Mersenne Twister
'  to Visual Basic. I found his math routines invaluable. See uAdd() routine.
'  http://www.math.sci.hiroshima-u.ac.jp/~m-mat/MT/VERSIONS/BASIC/basic.html
'
' ***************************************************************************
'  ISAAC has an output within these ranges:
'
'      -0.9999999999990, 0.9999999999990    Double Precision
'      -2147483648, 2147483647              Long Integer
'
' The output will pass all the Diehard and Ent randomness tests.  To build
' a test file, scroll down to Main_DH() routine.
'
' Diehard by George Marsaglia
' http://stat.fsu.edu/pub/diehard/
'
' Ent Software
' http://www.fourmilab.ch/random/
' Scroll down and download the file Random.zip
'
' ===========================================================================
'    DATE      NAME / eMAIL
'              DESCRIPTION
' -----------  --------------------------------------------------------------
' 21-Sep-2005  Kenneth Ives  kenaso@tx.rr.com
'              Module created
' 21-Oct-2005  Kenneth Ives  kenaso@tx.rr.com
'              Combined calcs for a double, speeded up the process.
'              Removed obsolete variables.
'              Optimized code.  Gained 9-12% increase in speed.
' 24-Mar-2006  Kenneth Ives  kenaso@tx.rr.com
'              Moved loading of the Power2 array to its own routine and
'              loaded with predefined values.
'              Updated logic in CreateSeed() routine.
' 10-Jan-2007  Kenneth Ives  kenaso@tx.rr.com
'              Replaced UnsignedAdd() routine with uAdd() routine.
'              Removed obsolete variables.
'              Optimized code.  Gained 10% increase in speed.
' 13-Jan-2007  Kenneth Ives  kenaso@tx.rr.com
'              Rewrote ShiftLong() routine and gained 2/10ths of a second.
' 25-Oct-2007  Kenneth Ives  kenaso@tx.rr.com
'              Combined a redundant set of calculations in the RandomInit()
'              routine and gained 3/10ths of a second.
' ***************************************************************************
Option Explicit

' ***************************************************************************
' Constants
' ***************************************************************************
  Private Const MODULE_NAME   As String = "clsISAAC"
  Private Const MAXDBL        As Double = 4294967296#
  Private Const MAXDBL_MINUS1 As Double = 4294967295#
  Private Const MAXLONG       As Double = 2147483647
  Private Const MAXLONG_NEG   As Double = -2147483648#

' ***************************************************************************
' API Declares
' ***************************************************************************
  ' The GetTickCount() API will capture the time in milliseconds.  The
  ' counter overflows after 1192.8 hours (49.7 days) from the last reboot.
  Private Declare Function GetTickCount Lib "kernel32" () As Long

' ***************************************************************************
' Module variables
' ***************************************************************************
  Private malngRand(256)   As Long
  Private malngMem(256)    As Long
  Private malngPower2(30)  As Long
  Private mlngSeed1        As Long
  Private mlngSeed2        As Long
  Private mlngSeed3        As Long
  
' ***************************************************************************
' Routine:       ISAAC_Prng
'
' Description:   A quantity of random values will be generated based on the
'                user request.
'
' Parameters:    lngArraySize - [Optional] Number of elements in return array.
'                     Default return number of 1.
'                blnReturnFloat - [Optional] Return random values in an array.
'                     TRUE - Double precision
'                     FALSE - Long integer
'
' Returns:       An array of random generated values
'
' ===========================================================================
'    DATE      NAME / eMAIL
'              DESCRIPTION
' -----------  --------------------------------------------------------------
' 21-Sep-2005  Kenneth Ives  kenaso@tx.rr.com
'              Routine created
' 21-Oct-2005  Kenneth Ives  kenaso@tx.rr.com
'              Combined calcs for a double, speeded up the process.
' 24-Mar-2006  Kenneth Ives  kenaso@tx.rr.com
'              Moved loading of the Power2 array to its own routine and loaded
'              with predefined values.
'              Moved call to Isaac_Calc to top of For..Next loop.
' ***************************************************************************
Public Function ISAAC_Prng(Optional ByVal lngArraySize As Long = 1, _
                           Optional ByVal blnReturnFloat As Boolean = True) As Variant

    Dim lngIndex   As Long
    Dim lngRand    As Long
    Dim lngLoop    As Long
    Dim lngCount   As Long
    Dim alngData() As Long
    Dim adblData() As Double

    On Error GoTo ISAAC_Prng_Error

    Erase malngRand()
    Erase malngMem()
    lngCount = 0
    
    ReDim adblData(lngArraySize)  ' resize the return arrays
    ReDim alngData(lngArraySize)
    Call LoadPower2               ' Load the Power2 array
    Call RandomInit(True)         ' full seeding and calculations

    ' Start creating the random data
    For lngIndex = 0 To lngArraySize - 1

        Call ISAAC_Calc   ' load the random data array
        
        ' unload the random data array into the appropriate return array
        For lngLoop = 0 To 255

            lngRand = malngRand(lngLoop)  ' capture one generated value

            If blnReturnFloat Then
                adblData(lngCount) = lngRand / MAXLONG  ' -0.9999999999990, 0.9999999999990
            Else
                alngData(lngCount) = lngRand             ' -2147483648, 2147483647
            End If

            lngCount = lngCount + 1

            ' if the requested number of elements have been
            ' collected then exit this loop
            If lngCount = lngArraySize Then
                Exit For
            End If

        Next lngLoop

        ' if the requested number of elements
        ' have been collected then exit loop
        If lngCount = lngArraySize Then
            Exit For
        End If

        Call RandomInit(False)           ' partial mixing and calculations

    Next lngIndex

ISAAC_Prng_CleanUp:
    If blnReturnFloat Then
        ISAAC_Prng = adblData()
    Else
        ISAAC_Prng = alngData()
    End If

    Erase alngData()   ' empty the arrays
    Erase adblData()
    Erase malngRand()
    Erase malngMem()
    Erase malngPower2()
    
    On Error GoTo 0    ' nullify this error trap
    Exit Function

ISAAC_Prng_Error:
    MsgBox "Err: " & CStr(Err.Number) & "  " & Err.Description
    ReDim alngData(1)    ' resize arrays to one element, return value = 0
    ReDim adblData(1)
    Resume ISAAC_Prng_CleanUp

End Function

' void isaac()
Private Sub ISAAC_Calc()

    ' register ub4 i,x,y;
    Dim intIndex  As Integer
    Dim intSwitch As Integer
    Dim XX        As Long
    Dim YY        As Long

    ' cc = cc + 1;    /* cc just gets incremented once per 256 results */
    ' bb = bb + cc;   /* then combined with bb */
    mlngSeed3 = mlngSeed3 + 1               ' mlngSeed3 just gets incremented once per 256 results
    mlngSeed2 = uAdd(mlngSeed2, mlngSeed3)  ' then combined with mlngSeed2

    ' removed switch statement for speed
    ' for (i=0; i<256; ++i)
    For intIndex = 0 To 252 Step 4

        'x = mm[i];
        'aa = aa^(aa<<13);
        'aa = mm[(i+128)%256] + aa;
        'mm[i] = y = mm[(x>>2)%256] + aa + bb;
        'randrsl[i] = bb = mm[(y>>10)%256] + x;
        XX = malngMem(intIndex)
        mlngSeed1 = mlngSeed1 Xor ShiftLong(mlngSeed1, 13)
        mlngSeed1 = uAdd(malngMem((intIndex + 128) Mod 256), mlngSeed1)
        YY = uAdd(uAdd(malngMem(Abs(ShiftLong(XX, 2, False)) Mod 256), mlngSeed1), mlngSeed2)
        malngMem(intIndex) = YY
        mlngSeed2 = uAdd(malngMem(Abs(ShiftLong(YY, 10, False)) Mod 256), XX)
        malngRand(intIndex) = mlngSeed2
        
        'x = mm[i+1];
        'aa = aa^(aa>>6);
        'aa = mm[(i+128+1)%256] + aa;
        'mm[i+1] = y = mm[(x>>2)%256] + aa + bb;
        'randrsl[i+1] = bb = mm[(y>>10)%256] + x;
        XX = malngMem(intIndex + 1)
        mlngSeed1 = mlngSeed1 Xor ShiftLong(mlngSeed1, 6, False)
        mlngSeed1 = uAdd(malngMem((intIndex + 128 + 1) Mod 256), mlngSeed1)
        YY = uAdd(uAdd(malngMem(Abs(ShiftLong(XX, 2, False)) Mod 256), mlngSeed1), mlngSeed2)
        malngMem(intIndex + 1) = YY
        mlngSeed2 = uAdd(malngMem(Abs(ShiftLong(YY, 10, False)) Mod 256), XX)
        malngRand(intIndex + 1) = mlngSeed2
        
        'x = mm[i+2];
        'aa = aa^(aa<<2);
        'aa = mm[(i+128+2)%256] + aa;
        'mm[i+2] = y = mm[(x>>2)%256] + aa + bb;
        'randrsl[i+2] = bb = mm[(y>>10)%256] + x;
        XX = malngMem(intIndex + 2)
        mlngSeed1 = mlngSeed1 Xor ShiftLong(mlngSeed1, 2)
        mlngSeed1 = uAdd(malngMem((intIndex + 128 + 2) Mod 256), mlngSeed1)
        YY = uAdd(uAdd(malngMem(Abs(ShiftLong(XX, 2, False)) Mod 256), mlngSeed1), mlngSeed2)
        malngMem(intIndex + 2) = YY
        mlngSeed2 = uAdd(malngMem(Abs(ShiftLong(YY, 10, False)) Mod 256), XX)
        malngRand(intIndex + 2) = mlngSeed2
        
        'x = mm[i+3];
        'aa = aa^(aa>>16);
        'aa = mm[(i+128+3)%256] + aa;
        'mm[i+3] = y = mm[(x>>2)%256] + aa + bb;
        'randrsl[i+3] = bb = mm[(y>>10)%256] + x;
        XX = malngMem(intIndex + 3)
        mlngSeed1 = mlngSeed1 Xor ShiftLong(mlngSeed1, 16, False)
        mlngSeed1 = uAdd(malngMem((intIndex + 128 + 3) Mod 256), mlngSeed1)
        YY = uAdd(uAdd(malngMem(Abs(ShiftLong(XX, 2, False)) Mod 256), mlngSeed1), mlngSeed2)
        malngMem(intIndex + 3) = YY
        mlngSeed2 = uAdd(malngMem(Abs(ShiftLong(YY, 10, False)) Mod 256), XX)
        malngRand(intIndex + 3) = mlngSeed2

    Next intIndex

End Sub

' void randinit(flag)
Private Sub RandomInit(ByRef blnSeed As Boolean)

    ' word flag;
    ' word i;
    ' ub4 a,b,c,d,e,f,g,h;
    Dim AA As Long, BB As Long, CC As Long, DD As Long
    Dim EE As Long, FF As Long, GG As Long, HH As Long
    Dim intIndex As Integer

    ' aa=bb=cc=0;   /* See CreateSeed()  Ken Ives */
    If blnSeed Then
        Call CreateSeed  ' fill the seeds with something
    End If

    ' Since this is a repeatable process by creating the same results
    ' each time then why not start with the results and skip the excess
    ' calculations. This will give me an additional 3/10ths of a second.
    '
    '    a=b=c=d=e=f=g=h=0x9e3779b9;  /* the golden ratio */
    '
    '    for (i=0; i<4; ++i)          /* scramble it */
    '        mix(a,b,c,d,e,f,g,h);
    AA = &HDFD5A9EA
    BB = &H3B122602
    CC = &H110FF1A8
    DD = &HFB44EDF1
    EE = &HEF3C10FD
    FF = &H1CEB6088
    GG = &H1D670408
    HH = &H3E01C8CE
    
    ' for (i=0; i<256; i+=8)   /* fill in mm[] with messy stuff */
    For intIndex = 0 To 248 Step 8

        ' if (flag)  /* use all the information in the seed */
        If blnSeed Then
            ' a+=randrsl[i  ]; b+=randrsl[i+1]; c+=randrsl[i+2]; d+=randrsl[i+3];
            ' e+=randrsl[i+4]; f+=randrsl[i+5]; g+=randrsl[i+6]; h+=randrsl[i+7];
            AA = uAdd(AA, malngRand(intIndex))
            BB = uAdd(BB, malngRand(intIndex + 1))
            CC = uAdd(CC, malngRand(intIndex + 2))
            DD = uAdd(DD, malngRand(intIndex + 3))
            EE = uAdd(EE, malngRand(intIndex + 4))
            FF = uAdd(FF, malngRand(intIndex + 5))
            GG = uAdd(GG, malngRand(intIndex + 6))
            HH = uAdd(HH, malngRand(intIndex + 7))
        End If

        ' mix(a,b,c,d,e,f,g,h);
        Call Mix(AA, BB, CC, DD, EE, FF, GG, HH)

        ' mm[i  ]=a; mm[i+1]=b; mm[i+2]=c; mm[i+3]=d;
        ' mm[i+4]=e; mm[i+5]=f; mm[i+6]=g; mm[i+7]=h;
        malngMem(intIndex) = AA
        malngMem(intIndex + 1) = BB
        malngMem(intIndex + 2) = CC
        malngMem(intIndex + 3) = DD
        malngMem(intIndex + 4) = EE
        malngMem(intIndex + 5) = FF
        malngMem(intIndex + 6) = GG
        malngMem(intIndex + 7) = HH
        
    Next intIndex

    ' if (flag)
    If blnSeed Then
        ' do a second pass to make all of
        ' the seed affect all of malngMem()
        '
        ' for (i=0; i<256; i+=8)
        For intIndex = 0 To 248 Step 8
            
            ' a+=mm[i  ]; b+=mm[i+1]; c+=mm[i+2]; d+=mm[i+3];
            ' e+=mm[i+4]; f+=mm[i+5]; g+=mm[i+6]; h+=mm[i+7];
            AA = uAdd(AA, malngMem(intIndex))
            BB = uAdd(BB, malngMem(intIndex + 1))
            CC = uAdd(CC, malngMem(intIndex + 2))
            DD = uAdd(DD, malngMem(intIndex + 3))
            EE = uAdd(EE, malngMem(intIndex + 4))
            FF = uAdd(FF, malngMem(intIndex + 5))
            GG = uAdd(GG, malngMem(intIndex + 6))
            HH = uAdd(HH, malngMem(intIndex + 7))

            ' mix(a,b,c,d,e,f,g,h);
            Call Mix(AA, BB, CC, DD, EE, FF, GG, HH)

            ' mm[i  ]=a; mm[i+1]=b; mm[i+2]=c; mm[i+3]=d;
            ' mm[i+4]=e; mm[i+5]=f; mm[i+6]=g; mm[i+7]=h;
            malngMem(intIndex) = AA
            malngMem(intIndex + 1) = BB
            malngMem(intIndex + 2) = CC
            malngMem(intIndex + 3) = DD
            malngMem(intIndex + 4) = EE
            malngMem(intIndex + 5) = FF
            malngMem(intIndex + 6) = GG
            malngMem(intIndex + 7) = HH
        
        Next intIndex
    End If

    ' isaac();  /* fill in the first set of results */
    Call ISAAC_Calc

End Sub

' #define mix(a,b,c,d,e,f,g,h) \
Private Sub Mix(ByRef AA As Long, _
                ByRef BB As Long, _
                ByRef CC As Long, _
                ByRef DD As Long, _
                ByRef EE As Long, _
                ByRef FF As Long, _
                ByRef GG As Long, _
                ByRef HH As Long)

    'a^=b<<11; d+=a; b+=c;
    'b^=c>>2; e+=b; c+=d;
    'c^=d<<8;  f+=c; d+=e;
    'd^=e>>16; g+=d; e+=f;
    'e^=f<<10; h+=e; f+=g;
    'f^=g>>4; a+=f; g+=h;
    'g^=h<<8;  b+=g; h+=a;
    'h^=a>>9; c+=h; a+=b;
    AA = AA Xor ShiftLong(BB, 11): DD = uAdd(DD, AA): BB = uAdd(BB, CC)
    BB = BB Xor ShiftLong(CC, 2, False): EE = uAdd(EE, BB): CC = uAdd(CC, DD)
    CC = CC Xor ShiftLong(DD, 8): FF = uAdd(FF, CC): DD = uAdd(DD, EE)
    DD = DD Xor ShiftLong(EE, 16, False): GG = uAdd(GG, DD): EE = uAdd(EE, FF)
    EE = EE Xor ShiftLong(FF, 10): HH = uAdd(HH, EE): FF = uAdd(FF, GG)
    FF = FF Xor ShiftLong(GG, 4, False): AA = uAdd(AA, FF): GG = uAdd(GG, HH)
    GG = GG Xor ShiftLong(HH, 8): BB = uAdd(BB, GG): HH = uAdd(HH, AA)
    HH = HH Xor ShiftLong(AA, 9, False): CC = uAdd(CC, HH): AA = uAdd(AA, BB)

End Sub

' ***************************************************************************
' Instead of setting the seed variables to zero, I prefer to fill them
' with something.
'
' Note from Mark Hutchinson's presentation about Microsoft's VB random number
' generator, invoke Rnd (-1) prior to Randomize statement in order to actually
' initialize with a new seed.
'
'        Rnd -1     ' Reset the random number generator
'        Randomize  ' Reseed the generator
'
' Mark Hutchinson   Aikimark@aol.com
' http://www.15seconds.com/issue/051110.htm
' ===========================================================================
'    DATE      NAME / eMAIL
'              DESCRIPTION
' -----------  --------------------------------------------------------------
' 21-Sep-2005  Kenneth Ives  kenaso@tx.rr.com
'              Routine created
' 24-Mar-2006  Kenneth Ives  kenaso@tx.rr.com
'              Updated logic in calculating and selecting values
' 10-Jan-2007  Kenneth Ives  kenaso@tx.rr.com
'              Reduced array size and reset range of seed3
' ***************************************************************************
Private Sub CreateSeed()

    Dim intIndex     As Integer
    Dim lngTemp      As Long
    Dim alngData(20) As Long
    
    Erase alngData()
    
    Rnd (-1)                   ' Reset VB Random Number Generator
    Randomize GetTickCount()   ' Reseed VB Random Number Generator
    
    lngTemp = uAdd(Int(Rnd * MAXLONG), GetTickCount())   ' start with a random value
    alngData(0) = CLng(lngTemp And &HFFFFFFFF)           ' create the starting value

    For intIndex = 1 To 20
    
        lngTemp = Int(Rnd * (alngData(intIndex - 1) / intIndex))
        lngTemp = uAdd(alngData(intIndex - 1), lngTemp)
        lngTemp = lngTemp Xor ShiftLong(lngTemp, 12)
        alngData(intIndex) = uAdd(lngTemp, alngData(intIndex - 1))
    
    Next intIndex
    
    ' Maintain positive values
    mlngSeed1 = Abs(alngData(Int(Rnd * 8) + 1))   ' 1-9
    mlngSeed2 = Abs(alngData(Int(Rnd * 9) + 11))  ' 11-20
    mlngSeed3 = Int(Abs(alngData(10)) / 2)        ' 10th element
    
    Erase alngData()
    
End Sub

' ***************************************************************************
' Routine:       uAdd
'
' Description:   Function to add two unsigned numbers together as in C.
'                Overflows are ignored!
'
' Parameters:    lngValue1 - Value of A
'                lngValue2 - Value of B
'
' Returns:       Calculated value
'
' ===========================================================================
'    DATE      NAME / eMAIL
'              DESCRIPTION
' -----------  --------------------------------------------------------------
' 18-Apr-2005  Pablo Mariano Ronchi  pmronchi@yahoo.com.ar
'              Routine created
' 19-Dec-2006  Kenneth Ives  kenaso@tx.rr.com
'              Modified variable names
' ***************************************************************************
Private Function uAdd(ByVal lngValue1 As Long, _
                      ByVal lngValue2 As Long) As Long
                             
    Dim dblTemp As Double

    dblTemp = CDbl(lngValue1) + CDbl(lngValue2)

    If dblTemp < MAXLONG_NEG Then
        uAdd = CLng(MAXDBL + dblTemp)
    Else
        If dblTemp > MAXLONG Then
            uAdd = CLng(dblTemp - MAXDBL)
        Else
            uAdd = CLng(dblTemp)
        End If
    End If

End Function

' ***************************************************************************
' Routine:       ShiftLong
'
' Description:   Shifts the bits to the right the specified number of
'                positions and returns the new value.  Bits "falling off"
'                the right edge do not wrap around.  Fill bits coming in from
'                left are 0.  A shift right is effectively a multiplication
'                by 2.  Some common languages like C/C++ or Java have an
'                operator for this job: ">>" or "<<".
'
' Parameters:    lngValue       - Number to be manipulated
'                intShiftCount  - number of shift positions
'                blnShiftLeft   - [Optional] Shift bits to the right or left.
'                                 Default is Left (TRUE)
'
' Returns:       New manipulated value
'
' ===========================================================================
'    DATE      NAME / eMAIL
'              DESCRIPTION
' -----------  --------------------------------------------------------------
' 09-Oct-2001  Shift right by Donald Lessau  donald@xbeat.net
' 28-Sep-2001  Shift left by Jost Schwider, jost@schwider.de
'              both routines found at http://www.xbeat.net/vbspeed/
' 13-Jan-2007  Kenneth Ives  kenaso@tx.rr.com
'              Combined routines and modified
' ***************************************************************************
Private Function ShiftLong(ByVal lngValue As Long, _
                           ByVal intShiftCount As Integer, _
                  Optional ByVal blnShiftLeft As Boolean = True) As Long

    Dim lngMask    As Long
    Dim lngIndex   As Long
    Dim lngSignBit As Long

    ' return the original value if Shift Count=0
    If intShiftCount <= 0 Then
        ShiftLong = lngValue
        Exit Function
    End If

    ' return zero if too many ShiftCounts
    If intShiftCount > 31 Then
        Exit Function
    End If

    If blnShiftLeft Then
        lngMask = malngPower2(31 - intShiftCount)
    
        If lngValue And lngMask Then
            ShiftLong = (lngValue And (lngMask - 1)) * malngPower2(intShiftCount) Or &H80000000
        Else
            ShiftLong = (lngValue And (lngMask - 1)) * malngPower2(intShiftCount)
        End If
    Else
        ' Shift right
        If intShiftCount < 31 Then
            If lngValue And &H80000000 Then
                ShiftLong = lngValue \ malngPower2(intShiftCount)
                
                If ShiftLong * malngPower2(intShiftCount) <> lngValue Then
                   ShiftLong = ShiftLong - 1
                End If
            Else
                ShiftLong = lngValue \ malngPower2(intShiftCount)
            End If
        Else
            If lngValue And &H80000000 Then
                ShiftLong = -1
            Else
                ShiftLong = 0
            End If
        End If
    End If
    
End Function

Private Sub LoadPower2()

    Erase malngPower2()
    
    malngPower2(0) = 1            ' 00000000000000000000000000000001
    malngPower2(1) = 2            ' 00000000000000000000000000000010
    malngPower2(2) = 4            ' 00000000000000000000000000000100
    malngPower2(3) = 8            ' 00000000000000000000000000001000
    malngPower2(4) = 16           ' 00000000000000000000000000010000
    malngPower2(5) = 32           ' 00000000000000000000000000100000
    malngPower2(6) = 64           ' 00000000000000000000000001000000
    malngPower2(7) = 128          ' 00000000000000000000000010000000
    malngPower2(8) = 256          ' 00000000000000000000000100000000
    malngPower2(9) = 512          ' 00000000000000000000001000000000
    malngPower2(10) = 1024        ' 00000000000000000000010000000000
    malngPower2(11) = 2048        ' 00000000000000000000100000000000
    malngPower2(12) = 4096        ' 00000000000000000001000000000000
    malngPower2(13) = 8192        ' 00000000000000000010000000000000
    malngPower2(14) = 16384       ' 00000000000000000100000000000000
    malngPower2(15) = 32768       ' 00000000000000001000000000000000
    malngPower2(16) = 65536       ' 00000000000000010000000000000000
    malngPower2(17) = 131072      ' 00000000000000100000000000000000
    malngPower2(18) = 262144      ' 00000000000001000000000000000000
    malngPower2(19) = 524288      ' 00000000000010000000000000000000
    malngPower2(20) = 1048576     ' 00000000000100000000000000000000
    malngPower2(21) = 2097152     ' 00000000001000000000000000000000
    malngPower2(22) = 4194304     ' 00000000010000000000000000000000
    malngPower2(23) = 8388608     ' 00000000100000000000000000000000
    malngPower2(24) = 16777216    ' 00000001000000000000000000000000
    malngPower2(25) = 33554432    ' 00000010000000000000000000000000
    malngPower2(26) = 67108864    ' 00000100000000000000000000000000
    malngPower2(27) = 134217728   ' 00001000000000000000000000000000
    malngPower2(28) = 268435456   ' 00010000000000000000000000000000
    malngPower2(29) = 536870912   ' 00100000000000000000000000000000
    malngPower2(30) = 1073741824  ' 01000000000000000000000000000000

End Sub


'*****************************************************************************
' Everything below is for testing only.  You may comment out or delete.
' 21-Oct-2005  Kenneth Ives  kenaso@tx.rr.com
'*****************************************************************************

Public Sub Main()
' ****************************************************************************
' For testing the ISAAC random number generator only.  Will create two files.
' One for float values and the other for long integers.  Only 1 in every 100
' values will be written to the file. Rename this routine when not wanted.
' ****************************************************************************

    Dim hFile       As Long
    Dim lngIndex    As Long
    Dim lngColCount As Long
    Dim lngCount    As Long
    Dim alngData()  As Long
    Dim adblData()  As Double
    Dim dblTotal    As Double
    Dim dblLow      As Double
    Dim dblHigh     As Double
    Dim strFmt      As String
    Dim strTemp     As String
    Dim strTitle    As String
    
    ' duration display only
    Dim lngStart    As Long
    Dim strElapsed  As String

    Const FN_DBL    As String = "C:\Isaac_Dbl.txt"
    Const FN_LNG    As String = "C:\Isaac_Lng.txt"
    Const FCOUNT    As Long = 100000
    Const SAMPLE    As Long = 100

    '******************************************************************
    ' Generate random float values  -0.9999999999990, 0.9999999999990
    '******************************************************************
    Screen.MousePointer = vbHourglass
    Erase adblData()
    lngColCount = 0
    lngCount = 0
    dblLow = 1#
    dblHigh = 0#
    dblTotal = 0#
    strFmt = String$(15, "@")
    strTitle = "ISAAC Double precision values" & vbCrLf & _
               Format$(FCOUNT, "#,0") & " random generated numbers" & vbCrLf & _
               "Saving every " & CStr(SAMPLE) & "th value for this display"

    '-----------------------------------------------------------------------------
    lngStart = GetTickCount()                           ' starting time
    adblData() = ISAAC_Prng(FCOUNT, True)               ' generate float values
    strElapsed = ElapsedTime(GetTickCount() - lngStart) ' finish time
    '-----------------------------------------------------------------------------

    ' Format the output
    For lngIndex = 0 To FCOUNT - 1

        dblTotal = dblTotal + adblData(lngIndex)  ' Accumulate overall total

        If dblLow > adblData(lngIndex) Then
            dblLow = adblData(lngIndex)           ' check for lowest value
        ElseIf adblData(lngIndex) > dblHigh Then
            dblHigh = adblData(lngIndex)          ' check for highest value
        End If

    Next lngIndex

    hFile = FreeFile                      ' get first free file handle
    Open FN_DBL For Output As #hFile      ' create empty output file

    Print #hFile, strTitle & vbCrLf       ' print the title
    Print #hFile, "Elapsed:  " & strElapsed & vbCrLf
        
    ' format and write the statistics to the file
    Print #hFile, " Lowest: " & Format$(FormatNumber(dblLow, 12), strFmt)
    Print #hFile, "Highest: " & Format$(FormatNumber(dblHigh, 12), strFmt)
    Print #hFile, " "

    ' dump the contents of the array to the output file
    For lngIndex = 0 To FCOUNT - 1

        ' Just use every 100th value for the output file
        If lngCount Mod SAMPLE = 0 Then
            ' write to the test file.
            strTemp = Format$(FormatNumber(adblData(lngIndex), 12), strFmt)
            Print #hFile, strTemp & Space$(2);   ' write to the file
            lngColCount = lngColCount + 1        ' increment column counter
        End If

        ' see if we have 5 columns
        If lngColCount = 5 Then
           Print #hFile, ""    ' prints Chr$(13) + Chr$(10) at the end of the line
           lngColCount = 0     ' reset column counter
        End If

        lngCount = lngCount + 1

    Next lngIndex

    Close #hFile
    Erase adblData()
    Screen.MousePointer = vbNormal
    
    MsgBox FN_DBL & vbCrLf & "Elapsed:  " & strElapsed, vbOKOnly, "ISAAC Float Values"

    '******************************************************************
    ' Generate long integer values  -2147483648, 2147483647
    '******************************************************************
    Screen.MousePointer = vbHourglass
    Erase alngData()
    lngColCount = 0
    lngCount = 0
    dblLow = MAXLONG
    dblHigh = 0#
    dblTotal = 0#
    strFmt = String$(11, "@")
    strTitle = "ISAAC Long Integer values" & vbCrLf & _
               Format$(FCOUNT, "#,0") & " random generated numbers" & vbCrLf & _
               "Saving every " & CStr(SAMPLE) & "th value for this display"
    
    '-----------------------------------------------------------------------------
    lngStart = GetTickCount()                           ' starting time
    alngData() = ISAAC_Prng(FCOUNT, False)              ' generate long integer values
    strElapsed = ElapsedTime(GetTickCount() - lngStart) ' finish time
    '-----------------------------------------------------------------------------

    ' Format the output
    For lngIndex = 0 To FCOUNT - 1

        dblTotal = dblTotal + alngData(lngIndex)  ' Accumulate overall total

        If dblLow > alngData(lngIndex) Then
            dblLow = alngData(lngIndex)           ' check for lowest value
        ElseIf alngData(lngIndex) > dblHigh Then
            dblHigh = alngData(lngIndex)          ' check for highest value
        End If

    Next lngIndex

    hFile = FreeFile                      ' get first free file handle
    Open FN_LNG For Output As #hFile      ' create empty output file

    Print #hFile, strTitle & vbCrLf       ' print the title
    Print #hFile, "Elapsed:  " & strElapsed & vbCrLf
        
    ' format and write the statistics to output file
    Print #hFile, " Lowest: " & Format$(dblLow, strFmt)
    Print #hFile, "Highest: " & Format$(dblHigh, strFmt)
    Print #hFile, " "

    ' dump the contents of the array to the output file
    For lngIndex = 0 To FCOUNT - 1

        ' Just use every 100th value for the output file
        If lngCount Mod SAMPLE = 0 Then
            strTemp = Format$(alngData(lngIndex), strFmt)  ' format output record
            Print #hFile, strTemp & Space$(2);             ' write to output file
            lngColCount = lngColCount + 1                  ' increment column counter
        End If

        ' see if we have 6 columns
        If lngColCount = 6 Then
           Print #hFile, ""         ' prints Chr$(13) + Chr$(10) at the end of the line
           lngColCount = 0          ' reset column counter
        End If

        lngCount = lngCount + 1

    Next lngIndex

    Close #hFile
    Erase alngData()
    Erase adblData()
    Screen.MousePointer = vbNormal
    
    MsgBox FN_LNG & vbCrLf & "Elapsed:  " & strElapsed & vbCrLf & vbCrLf & _
           "TESTING COMPLETE!", vbOKOnly, "ISAAC Long Integers"

End Sub

Public Sub Main_DH()
' ****************************************************************************
' Rename this routine to Main() and press F5 to execute. This will build the
' approximate 11mb (11,468,800 bytes) binary input file needed when using
' Diehard or ENT for randomness testing.  On a 500mhz, 256mb RAM PC, this will
' take less than two minutes to create the test file in the IDE, compiled will
' take 12 seconds.
'
' Test file size:  2,867,200 32-bit random integers (11,468,800 bytes)
'                  11,468,800 bytes = 10240 * 280 * 4
'                                        |     |    |__ 4 bytes = 1 long integer
'                                        |     |__ # of writes to output file
'                                        |__ # of long integers per array
'
' ---------------------------------
' Randomness testing software
' ---------------------------------
' Diehard by George Marsaglia
' http://stat.fsu.edu/pub/diehard/
'
' ENT Software
' http://www.fourmilab.ch/random/
' Scroll down and download the file Random.zip
'
' ****************************************************************************

    Dim hFile       As Integer
    Dim alngData()  As Long
    Dim lngPointer  As Long
    Dim lngLoop     As Long
    
    ' duration display only
    Dim lngStart    As Long
    Dim strElapsed  As String

    Const FN_TEST   As String = "C:\Isaac.bin"
    Const FCOUNT    As Long = 10240

    Screen.MousePointer = vbHourglass
    lngPointer = 1                        ' init pointer for output file
    Erase alngData()                      ' empty the temp array

    hFile = FreeFile                      ' capture first free file handle
    Open FN_TEST For Output As #hFile     ' Create an empty file
    Close #hFile                          ' close the file

    hFile = FreeFile                                 ' capture first free file handle
    Open FN_TEST For Binary Access Write As #hFile   ' re-open file in binary mode

    '-----------------------------------------------------------------------------
    lngStart = GetTickCount()                            ' Starting time
    
    ' Generate some random data and write to a file.
    ' The first 11,467,684 bytes.
    For lngLoop = 1 To 280

        alngData() = ISAAC_Prng(FCOUNT, False)           ' Create long integer numbers
        ReDim Preserve alngData(FCOUNT - 1)              ' Resize the array
        Put #hFile, lngPointer, alngData()               ' Write data to output file
        lngPointer = lngPointer + (UBound(alngData) * 4) ' Update pointer for output file
        Erase alngData()                                 ' Empty temp array

    Next lngLoop
    
    ' Generate and write the remaining
    ' 1,116 bytes.
    alngData() = ISAAC_Prng(280, False)                  ' Create long integer numbers
    ReDim Preserve alngData(279)                         ' Resize the array
    Put #hFile, lngPointer, alngData()                   ' Write data to output file
    Erase alngData()                                     ' Empty temp array

    strElapsed = ElapsedTime(GetTickCount() - lngStart)  ' Finish time
    '-----------------------------------------------------------------------------
    
    Close #hFile                    ' close the output file
    Erase alngData()                ' Always make sure arrays are empty when not in use
    Screen.MousePointer = vbNormal  ' Reset mouse cursor
    
    MsgBox FN_TEST & vbCrLf & "Elapsed:  " & strElapsed & vbCrLf & vbCrLf & _
           "TEST FILE COMPLETE!", vbOKOnly, "ISAAC Diehard/ENT test file"

End Sub

' ***************************************************************************
' Routine:       ElapsedTime
'
' Description:   Formats time display
'
' Parameters:    lngMilliseconds - current time in seconds
'
' Returns:       Formatted output
'
' ===========================================================================
'    DATE      NAME / eMAIL
'              DESCRIPTION
' -----------  --------------------------------------------------------------
' 06-NOV-2004  Kenneth Ives  kenaso@tx.rr.com
'              Wrote routine
' ***************************************************************************
Private Function ElapsedTime(ByVal lngMilliseconds As Long) As String

    Dim lngSeconds   As Long
    Dim lngMinutes   As Long
    Dim lngHours     As Long
    Dim lngDays      As Long
    Dim lngThousands As Long

    ElapsedTime = ""
    
    lngSeconds = Int(lngMilliseconds / 1000)              ' Convert to whole seconds
    lngThousands = lngMilliseconds - (lngSeconds * 1000)  ' Capture any remaining milliseconds
    lngDays = Int(lngSeconds / 86400)                     ' Calc number of days
    lngSeconds = lngSeconds - (lngDays * 86400)           ' Recalc number of seconds
    lngHours = Int(lngSeconds / 3600)                     ' Calc number of hours
    lngSeconds = lngSeconds - (lngHours * 3600)           ' Recalc number of seconds
    lngMinutes = Int(lngSeconds / 60)                     ' Calc number of minutes
    lngSeconds = lngSeconds - (lngMinutes * 60)           ' Recalc number of seconds

    ' Format number of days, if any
    If lngDays > 0 Then
        ElapsedTime = Format$(lngDays, "0") & " day(s)  "
    End If
    
    ElapsedTime = ElapsedTime & _
                  Format$(lngHours, "0") & ":" & _
                  Format$(lngMinutes, "00") & ":" & _
                  Format$(lngSeconds, "00") & "." & _
                  Format$(lngThousands, "000")
    
End Function