Attribute VB_Name = "basISAAC"
' ***************************************************************************
' Module:        basISAAC.bas
'
' 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.
'
'  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
'
' *****************************************************************************
'
' THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
' "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
' LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
' A PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT
' OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
' SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
' TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
' PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
' LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
' NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
' SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
'
' ===========================================================================
'    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
'              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.
' 04-Feb-2008  Kenneth Ives  kenaso@tx.rr.com
'              Updated the CreateSeed() routine to use a global variable as
'              a unique input value due to the newer CPU speeds.  Created a
'              separate routine for processing a double precision value
'              named CalcOneDouble().
' 30-May-2008  Kenneth Ives  kenaso@tx.rr.com
'              Updated Isaac_Calc() routine to gain speed.
' 21-Aug-2008  Kenneth Ives  kenaso@tx.rr.com
'              Updated seed creation process
' ***************************************************************************
Option Explicit

' ***************************************************************************
' Constants
' ***************************************************************************
  Private Const MODULE_NAME    As String = "basISAAC"
  Private Const MAXLONG        As Long = 2147483647
  Private Const MAXLONG_NEG    As Double = -2147483648#
  Private Const MAXDBL         As Double = 4294967296#
  Private Const MAXDBL_MINUS_1 As Double = 4294967295#
  Private Const DBL_LOW        As Double = 0.000000000001
  Private Const DBL_HIGH       As Double = 1.999999999998 / MAXDBL_MINUS_1

' ***************************************************************************
' 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

' ***************************************************************************
' Global variables
' ***************************************************************************
  Public glngCarryOverSeed As Long
  
' ***************************************************************************
' Module variables
' ***************************************************************************
  Private malngRand(256)  As Long
  Private malngMem(256)   As Long
  Private malngPower2(30) As Long
  Private malngSeed(3)    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 lngIdx     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 alngData()  ' Always start with empty arrays
    Erase adblData()
    Erase malngRand()
    Erase malngMem()
    Erase malngPower2()
    lngCount = 0
    
    ' Based on type of data desired, adjust
    ' the appropriate return array.
    If blnReturnFloat Then
        ReDim adblData(lngArraySize)
    Else
        ReDim alngData(lngArraySize)
    End If
    
    LoadPower2        ' Load the Power2 array
    RandomInit True   ' Full seeding, mixing and calculations
    
    ' Start creating the random data
    For lngIndex = 0 To lngArraySize - 1
                
        ISAAC_Calc  ' load the random data array
        
        ' unload the random data array into
        ' the appropriate return array
        For lngIdx = 0 To 255

            If blnReturnFloat Then
                ' returns -0.9999999999990 to 0.9999999999990
                adblData(lngCount) = CalcOneDouble(malngRand(lngIdx))
            Else
                ' returns -2147483648 to 2147483647
                alngData(lngCount) = malngRand(lngIdx)
            End If

            lngCount = lngCount + 1  ' increment counter

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

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

        RandomInit False  ' No seeding.  Mixing and calculations only.
    
    Next lngIndex

ISAAC_Prng_CleanUp:
    If blnReturnFloat Then
        ISAAC_Prng = adblData()  ' Return float values
    Else
        ISAAC_Prng = alngData()  ' Return long integer values
    End If

    Erase alngData()   ' Always empty arrays when not needed
    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

' ***************************************************************************
' Routine:       CalcOneDouble
'
' Description:   Convert a long integer to a double precision number.
'                Returns a decimal position of 14 places. This was
'                chosen so that exponentials would not be returned.
'                If you are working with large numbers then your return
'                values will probably be in string format so as to get
'                the full value of your calculations.
'
'                    Ex: 2147483647  ->  -2.32830732662872E-10
'
'                The desired return values are with these ranges:
'
'                    -0.99999999999990 to 0.99999999999990
'
'                    Ex: 2147483647  ->  -0.00000000023283
'
' Parameters:    lngValue - Number to be converted
'
' Returns:       Double precision value
'
' ===========================================================================
'    DATE      NAME / eMAIL
'              DESCRIPTION
' -----------  --------------------------------------------------------------
' 04-Feb-2008  Kenneth Ives  kenaso@tx.rr.com
'              Routine created
' ***************************************************************************
Private Function CalcOneDouble(ByVal lngRand As Long) As Double

    Dim dblTemp As Double

    If lngRand < 0 Then
        dblTemp = lngRand + MAXDBL
    Else
        dblTemp = lngRand
    End If

    CalcOneDouble = FormatNumber(DBL_LOW + ((dblTemp * DBL_HIGH) - 1#), 14)

End Function

' 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.
    '
    '    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.
        ' Will 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): 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): 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): 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): CC = uAdd(CC, HH): AA = uAdd(AA, BB)

End Sub

' 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 */
    malngSeed(2) = malngSeed(2) + 1
    malngSeed(1) = uAdd(malngSeed(1), malngSeed(2))

    ' 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)
        malngSeed(0) = malngSeed(0) Xor ShiftLong(malngSeed(0), 13)
        malngSeed(0) = uAdd(malngMem((intIndex + 128) Mod 256), malngSeed(0))
        YY = uAdd(uAdd(malngMem(Abs(ShiftLong(XX, -2)) Mod 256), malngSeed(0)), malngSeed(1))
        malngMem(intIndex) = YY
        malngSeed(1) = uAdd(malngMem(Abs(ShiftLong(YY, -10)) Mod 256), XX)
        malngRand(intIndex) = malngSeed(1)
        
        ' 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)
        malngSeed(0) = malngSeed(0) Xor ShiftLong(malngSeed(0), -6)
        malngSeed(0) = uAdd(malngMem((intIndex + 128 + 1) Mod 256), malngSeed(0))
        YY = uAdd(uAdd(malngMem(Abs(ShiftLong(XX, -2)) Mod 256), malngSeed(0)), malngSeed(1))
        malngMem(intIndex + 1) = YY
        malngSeed(1) = uAdd(malngMem(Abs(ShiftLong(YY, -10)) Mod 256), XX)
        malngRand(intIndex + 1) = malngSeed(1)
        
        ' 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)
        malngSeed(0) = malngSeed(0) Xor ShiftLong(malngSeed(0), 2)
        malngSeed(0) = uAdd(malngMem((intIndex + 128 + 2) Mod 256), malngSeed(0))
        YY = uAdd(uAdd(malngMem(Abs(ShiftLong(XX, -2)) Mod 256), malngSeed(0)), malngSeed(1))
        malngMem(intIndex + 2) = YY
        malngSeed(1) = uAdd(malngMem(Abs(ShiftLong(YY, -10)) Mod 256), XX)
        malngRand(intIndex + 2) = malngSeed(1)
        
        ' 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)
        malngSeed(0) = malngSeed(0) Xor ShiftLong(malngSeed(0), -16)
        malngSeed(0) = uAdd(malngMem((intIndex + 128 + 3) Mod 256), malngSeed(0))
        YY = uAdd(uAdd(malngMem(Abs(ShiftLong(XX, -2)) Mod 256), malngSeed(0)), malngSeed(1))
        malngMem(intIndex + 3) = YY
        malngSeed(1) = uAdd(malngMem(Abs(ShiftLong(YY, -10)) Mod 256), XX)
        malngRand(intIndex + 3) = malngSeed(1)

    Next intIndex

End Sub

' ***************************************************************************
' I prefer to calculate the seed values.  Because the new CPU's are so fast,
' I have opted to carry over one of the generated values in a global variable
' just to make sure I have a unique value to start my calculations.  Getting
' just the system time will show that only 1-3 milliseconds may have changed
' since the last pass through this routine. This will generate almost, if not
' the same, values.  Using a global variable, these calculated values will
' always be different.
' ===========================================================================
'    DATE      NAME / eMAIL
'              DESCRIPTION
' -----------  --------------------------------------------------------------
' 10-Dec-2007  Kenneth Ives  kenaso@tx.rr.com
'              Routine created
' 30-May-2008  Kenneth Ives  kenaso@tx.rr.com
'              Updated the way seed values are generated
' 21-Aug-2008  Kenneth Ives  kenaso@tx.rr.com
'              Updated seed creation process
' ***************************************************************************
Private Sub CreateSeed()

    Dim lngIndex     As Long
    Dim lngTemp      As Long
    Dim alngData(20) As Long
    
    If glngCarryOverSeed = 0 Then
        glngCarryOverSeed = GetTickCount()
    End If
    
    Erase alngData()   ' Always start with empty arrays
    Erase malngSeed()
        
    For lngIndex = 0 To 20

        alngData(lngIndex) = glngCarryOverSeed And &HFFFFFFFF
        lngTemp = Int(alngData(lngIndex) / (lngIndex + 1))
        lngTemp = uAdd(alngData(lngIndex), lngTemp)
        lngTemp = lngTemp Xor ShiftLong(lngTemp, 12)
        alngData(lngIndex) = lngTemp
        glngCarryOverSeed = uAdd(lngTemp, glngCarryOverSeed)
        
    Next lngIndex

    ' Maintain positive values while selecting 3 seed values
    lngIndex = CLng(Right$(CStr(alngData(10)), 1))     ' Capture last digit (0-9)
    malngSeed(0) = Abs(alngData(lngIndex + 1))         ' 1-10
    malngSeed(1) = Abs(alngData(lngIndex + 10))        ' 10-19
    malngSeed(2) = Val(Right$(CStr(alngData(20)), 6))  ' Capture last 6 digits
    
    Erase alngData()  ' Always empty arrays when not needed
    
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
'                intBitCount  - Number of shift positions
'                               If shift count is positive then shift to
'                               the left.  If shift count is negative then
'                               shift to the right.
'
'                Example:  ShiftLong 12345, 12   ' Shift left 12 positions
'                          ShiftLong 12345, -12  ' Shift right 12 positions
'
' Returns:       New manipulated value
'
' ===========================================================================
'    DATE      NAME / eMAIL
'              DESCRIPTION
' -----------  --------------------------------------------------------------
' 26-Jun-1999  Francesco Balena (Formerly VB2TheMax)
'              http://www.devx.com/vb2themax/Tip/18952  (Shift Left)
'              http://www.devx.com/vb2themax/Tip/18953  (Shift Right)
' 13-Jan-2007  Kenneth Ives  kenaso@tx.rr.com
'              Combined routines. Modified intBitCount to be a switch
'              denoting either a left (positive) or right (negative) shift.
' ***************************************************************************
Private Function ShiftLong(ByVal lngValue As Long, _
                           ByVal intBitCount As Integer) As Long

    Dim lngMask    As Long
    Dim lngSignBit As Long
         
    ' Test bit shifting ranges
    Select Case intBitCount
           Case 0
                ' No bit shifting requested
                ' Fall thru and return original value
                
           Case Is < -31
                ' return zero if too many
                ' negative shift positions
                lngValue = 0
                
           Case Is > 31
                ' return zero if too many
                ' positive shift positions
                lngValue = 0
                
           Case Is > 0
                ' Shift to the left if a positive bit count
                ' Extract the bit in lngValue
                ' that will become the sign bit
                lngMask = malngPower2(31 - intBitCount)
                
                ' Calculate the sign bit of the result
                lngSignBit = CBool(lngValue And lngMask) And &H80000000
                
                ' Clear all the most significant intBitCount, that
                ' would be lost anyway, and also clear the sign bit
                lngValue = lngValue And (lngMask - 1)
                
                ' Do the shift to the left, without risking
                ' an overflow and then add the sign bit
                lngValue = (lngValue * malngPower2(intBitCount)) Or lngSignBit
        
           Case Is < 0
                ' Shift to the right if a negative bit count
                ' Convert intBitCount to a positive value
                intBitCount = Abs(intBitCount)
                
                ' Evaluate the sign bit in advance
                lngSignBit = (lngValue < 0) And malngPower2(31 - intBitCount)
                
                ' Create a lngMask with 1's for the
                ' digits that will be preserved
                If intBitCount < 31 Then
                    
                    ' if intBitCount=31 then the lngMask is zero
                    lngMask = Not (malngPower2(intBitCount) - 1)
                    
                End If
                
                ' Clear all the digits that will
                ' be discarded, and also clear
                ' the sign bit
                lngValue = (lngValue And &H7FFFFFFF) And lngMask
                
                ' Do the shift and add the sign bit
                lngValue = (lngValue \ malngPower2(intBitCount)) Or lngSignBit
    End Select
    
    ShiftLong = lngValue
    
End Function

Private Sub LoadPower2()

    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
'*****************************************************************************

' ****************************************************************************
' 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.
' ****************************************************************************
Public Sub Main()

    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:\Temp\Isaac_Dbl.txt"
    Const FN_LNG    As String = "C:\Temp\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$(18, "@")
    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)  ' calc 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, 14), strFmt)
    Print #hFile, "Highest: " & Format$(FormatNumber(dblHigh, 14), strFmt)
    Print #hFile, " Median: " & Format$(FormatNumber((dblTotal / FCOUNT), 6), String$(10, "@"))
    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), 14), strFmt)
            Print #hFile, strTemp & Space$(2);   ' write to the file
            lngColCount = lngColCount + 1        ' increment column counter
        End If

        ' see if we have 4 columns
        If lngColCount = 4 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 float values
    strElapsed = ElapsedTime(GetTickCount() - lngStart)  ' calc 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, " Median: " & Format$((dblHigh \ FCOUNT), 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()  ' Always empty arrays when not needed
    Erase adblData()
    Screen.MousePointer = vbNormal
    
    MsgBox FN_LNG & vbCrLf & "Elapsed:  " & strElapsed & vbCrLf & vbCrLf & _
           "TESTING COMPLETE!", vbOKOnly, "ISAAC Long Integers"

End Sub

' ****************************************************************************
' 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
'
' ****************************************************************************
Public Sub Main_DH()

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

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

    DoEvents
    Screen.MousePointer = vbHourglass
    DoEvents
    
    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

    lngStop = GetTickCount()                       ' stopping time
    strElapsed = ElapsedTime(lngStop - lngStart)   ' calc millisecond difference
    '-----------------------------------------------------------------------------
    
    Close #hFile                    ' close the output file
    Erase alngData()                ' Always make sure arrays are empty when not in use
    
    DoEvents
    Screen.MousePointer = vbNormal  ' Reset mouse cursor
    DoEvents
    
    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