Option Explicit
Option Base 0
'The above Option X's commands must be the 1st.lines in the file.
'Option Compare Database    'DO NOT USE IN THIS MODULE, not even for MS Access





'This is the Visual Basic for Applications (VBA) program for full testing the VBA version
'of the   "MERSENNE TWISTER"   algorithm for pseudo random number generation,
'with initialization improved, by  MAKOTO MATSUMOTO  and  TAKUJI NISHIMURA,
'of  2002/1/26.
'This test program was made and tested by Pablo Mariano Ronchi (2005-Sep-12)



'Note 1: VBA is the Visual Basic language used in MS Access, MS Excel and, in general,
'        in MS Office, and is called simply "Visual Basic" or VBA, hereinafter.
'Note 2: This same code compiles in Visual Basic (VB) without modifications.




'COMMENTS ABOUT THIS VISUAL BASIC FOR APPLICATIONS (VBA) PROGRAM FOR TESTING
'THE VBA VERSION OF THE  "Mersenne Twister"  ALGORITHM:
'
'- All the statements made by the authors of the original algorithm and implementation
'  and present in the original C code, including but not limiting to those regarding
'  the license, the usage without any warranties, and the conditions for distribution,
'  apply to this Visual Basic program for testing that algorithm.
'
'- USAGE:
'
'  In your Visual Basic application (MS Access, MS Excel, VB compiler, etc):
'
'  1) Add the module that implements in Visual Basic the algorithm that we are testing
'     (I suggest calling that module "mt19937ar". Its source file is "mt19937arVBcode.txt").
'
'  2) Add this source file as another module with the proper name
'     (I suggest "mt19937arFullTest")
'
'  3) Run the test by placing the cursor in any line of the function MtArFullTest()
'     and clicking the "Run Sub/UserForm" (or pressing the F5 key).
'     DO NOT RUN the function main() present in the module that we called "mt19937ar"
'     in this example.
'     Note: for the VB compiler, delete the main() function mentioned above, and rename
'           MtArFullTest() in this source file as main().
'
'  4) If you have compiled and run the C version of this test program, you can compare
'     the output files manually following this procedure:
'     a) Open both text files.
'     b) Maximize their windows (from keyboard: <left Alt> + <Space bar>, and then <X>).
'     c) Quickly alternate between both files typing:
'        <left Alt> + <Tab>, <left Alt> + <Tab>, ...
'        Any difference between the files (time values, for example) will be
'        self evident.
'
'  Note: If you cannot find the output of this VB program, it is probably in
'        "My Documents" folder.
'
'
'  HOW TO ADAPT THE TEST TO YOUR PARTICULAR NEEDS:
'
'  Within MtArFullTest() you will find sets of constants for each part of the test.
'  Just change their values. Of course, change also the same values in the C code to
'  run the test in exactly the same way.
'  For instance, for the first part of the test, you will find:
'
'     Const kRun1stPart As Boolean = True
'     Const kMaxNr1 As Long = 1000000        '1000000
'     Const kPrintEachNth1 As Long = 10000   '10000
'
'  In this case, the 1st part of the test will be run, a million numbers will be generated,
'  but just a hundred (1000000/10000) of them will be printed into the result test file.
'
'  Note:
'     The actual generation and printing is performed by MtArTest(), which is called as
'     many times as needed from within MtArFullTest()
'
'  WARNING:
'     I have provided 3 different values for the constant kMaxNr2 (for the 2nd. part of
'     the test): 1, 10, and 100 million (1 million is the default). The time that took
'     the test to complete in my old Pentium MMX, 120Mhz, using the 100 million value was
'     of 6072 seconds (1h41m), while for the 1 million value was of 123 seconds. Expect
'     values proportional to your machine's Mhz and architecture using similar limits.
'     (All the parts of the test other than the 2nd. one kept their default values).
'
'
'  Pablo Mariano Ronchi
'  Buenos Aires, Argentina
'
'
'
'End of comments for the Visual Basic program for testing mt19937ar



Const kgenrand_int32 As Integer = 1
Const kgenrand_int31 As Integer = 2
Const kgenrand_real1 As Integer = 3
Const kgenrand_real2 As Integer = 4
Const kgenrand_real3 As Integer = 5
Const kgenrand_res53 As Integer = 6
Const kgenrand_int32SignedLong As Integer = 7
Const kgenrand_real2b As Integer = 8
Const kgenrand_real2c As Integer = 9
Const kgenrand_real3b As Integer = 10
Const kgenrand_real4b As Integer = 11
Const kgenrand_real5b As Integer = 12


'The value of the following constants MUST MATCH the equivalent constants in
'the VBA module "mt19937ar":
Const k2_31 As Double = 2147483648#     '2^31   ==  2147483648 == 80000000
Const k2_31Neg As Double = 0# - k2_31   '-2^31  == -2147483648 == 80000000
Const k2_31b As Double = k2_31 - 1#     '2^31-1 ==  2147483647 == 7FFFFFFF
Const kDefaultSeed As Long = 5489


Dim TestN As Long, TestP As Double    'for testing






Function GetSeconds(tmp As Double) As String
'The operations are needed to avoid local formatting of numbers. In Argentina, for instance,
'we use decimal comma (pi=3,14) instead of decimal point (pi=3.14):
GetSeconds = Fix(tmp) & "." & Format(Fix((tmp - Fix(tmp) + 0.005) * 100), "00")
             '& " second" & IIf((Fix(tmp) = 1), "", "s")
End Function    'GetSeconds




Private Sub MtArTest(ByVal kMaxNr As Long, ByVal kPrintEachNth As Long, _
                          fcod As Integer, withtime As Boolean)
Dim intfn As Boolean
Dim ii As Long, cp As Long
Dim tmp As Double, s As String, fn As String
Dim sec1 As Double, sec2 As Double

'(Before calling the Timer) following code generates and prints the 1st number:
TestN = TestN + 1
TestP = TestP + 1
cp = 0
sec1 = Timer

'print the first number:
Select Case fcod
    Case kgenrand_int32:
        tmp = genrand_int32()
        fn = "genrand_int32()"
    Case kgenrand_int31:
        tmp = genrand_int31()
        fn = "genrand_int31()"
    Case kgenrand_real1:
        tmp = genrand_real1()
        fn = "genrand_real1()"
    Case kgenrand_real2:
        tmp = genrand_real2()
        fn = "genrand_real2()"
    Case kgenrand_real3:
        tmp = genrand_real3()
        fn = "genrand_real3()"
    Case kgenrand_res53:
        tmp = genrand_res53()
        fn = "genrand_res53()"
    Case kgenrand_int32SignedLong:
        tmp = genrand_int32SignedLong()
        fn = "genrand_int32SignedLong()"
    Case kgenrand_real2b:
        tmp = genrand_real2b()
        fn = "genrand_real2b()"
    Case kgenrand_real2c:
        tmp = genrand_real2c()
        fn = "genrand_real2c()"
    Case kgenrand_real3b:
        tmp = genrand_real3b()
        fn = "genrand_real3b()"
    Case kgenrand_real4b:
        tmp = genrand_real4b()
        fn = "genrand_real4b()"
    Case kgenrand_real5b:
        tmp = genrand_real5b()
        fn = "genrand_real5b()"
    Case Else:
        tmp = 0#
        fn = "NO FUNCTION"
End Select

Print #1, Trim((kMaxNr \ kPrintEachNth) + 1); " of "; Trim(kMaxNr); " outputs of " & fn & ":"
Print #1, ""

intfn = (fcod = 2 Or fcod = 1 Or fcod = 7)

If intfn Then
    s = tmp: If Len(s) < 11 Then s = Space(11 - Len(s)) & s
Else
    s = Format(tmp, "0.00000000")
    'to force decimal point instead of decimal comma (as we use in Argentina):
    If tmp <= 1# And tmp >= 0# Then s = "0." & Right(s, 8)
    If tmp >= -1# And tmp < 0# Then s = "-0." & Right(s, 8)
End If

Print #1, s; IIf(intfn, " ", ""); " <-- this is the first number; then each "; _
             IIf((kPrintEachNth > 1), Trim(CStr(kPrintEachNth)) & "th number", "one"); " is printed:"


For ii = 2 To kMaxNr

    Select Case fcod
        Case kgenrand_int32: tmp = genrand_int32()
        Case kgenrand_int31: tmp = genrand_int31()
        Case kgenrand_real1: tmp = genrand_real1()
        Case kgenrand_real2: tmp = genrand_real2()
        Case kgenrand_real3: tmp = genrand_real3()
        Case kgenrand_res53: tmp = genrand_res53()
        Case kgenrand_int32SignedLong: tmp = genrand_int32SignedLong()
        Case kgenrand_real2b: tmp = genrand_real2b()
        Case kgenrand_real2c: tmp = genrand_real2c()
        Case kgenrand_real3b: tmp = genrand_real3b()
        Case kgenrand_real4b: tmp = genrand_real4b()
        Case kgenrand_real5b: tmp = genrand_real5b()
        Case Else: tmp = 0#
    End Select

    If ii Mod kPrintEachNth = 0 Then
        cp = cp + 1
        
        If intfn Then
            s = tmp: If Len(s) < 11 Then s = Space(11 - Len(s)) & s
        Else
            s = Format(tmp, "0.00000000")
            'to force decimal point instead of decimal comma (as we use in Argentina):
            If tmp <= 1# And tmp >= 0# Then s = "0." & Right(s, 8)
            If tmp >= -1# And tmp < 0# Then s = "-0." & Right(s, 8)
        End If
        
        Print #1, s;
        TestP = TestP + 1
        
        If cp = 5 Then
            cp = 0
            Print #1, " "
        Else
            Print #1, " ";
        End If
    End If

Next

sec2 = Timer
TestN = TestN + kMaxNr - 1

If withtime Then
    tmp = sec2 - sec1
    Print #1, ""
    Print #1, "Elapsed time in seconds for generating "; Trim(kMaxNr); " numbers and printing "; _
              Trim((kMaxNr \ kPrintEachNth) + 1); " of them: "; GetSeconds(tmp)
End If

Print #1, ""
Print #1, ""
End Sub 'MtArTest




Private Sub MtArFullTest()
'This test consists of many parts, each part generating kMaxNr numbers but printing
'into the output file just each kPrintEachNth of them. The output file could be compared
'with a similar C test also provided.

'The following constants are for the component parts of the test:

Const kRun1stPart As Boolean = True
Const kMaxNr1 As Long = 1000000        '1000000
Const kPrintEachNth1 As Long = 10000   '10000

Const kRun2ndPart As Boolean = True
'Const kMaxNr2 As Long = 100000000      '100000000==1e8
'Const kMaxNr2 As Long = 10000000       '10000000==1e7
Const kMaxNr2 As Long = 1000000        '1000000==1e6
Const kPrintEachNth2 As Long = 0       'not used

Const kRun3rdPart As Boolean = True
Const kMaxNr3 As Long = 1000           '1000
Const kPrintEachNth3 As Long = 100     '100

Const kRun4thPart As Boolean = True
Const kMaxNr4 As Long = 1000           '1000
Const kPrintEachNth4 As Long = 100     '100



Dim init As Variant: init = Array(&H123, &H234, &H345, &H456)
'the following array differs from the previous one in just the last bit:
Dim init2 As Variant: init2 = Array(&H123, &H234, &H345, &H457)
'extreme cases:
Dim init3 As Variant: init3 = Array(0, 0, 0, 0)
Dim init4 As Variant: init4 = Array(&HFFFFFFFF, &HFFFFFFFF, &HFFFFFFFF, &HFFFFFFFF)
Dim length As Long: length = 4

Dim ii As Long, seed As Long, aa As Double, bb As Double
Dim s As String, Tit1 As String, Tit2 As String, fn As String
Dim sec1 As Double, sec2 As Double, secA As Double, secB As Double


fn = "mt19937arVBFullTest.txt"
Open fn For Output As #1    'open the output file
TestN = 0
TestP = 0
Tit1 = "Full Testing of the Mersenne Twister functions (MT19937ar)"
Tit2 = "Visual Basic version"
s = "=========================================================="
Print #1, s
Print #1, Tit1
Print #1, Tit2
Print #1, s
Print #1, ""
Print #1, ""

secA = Timer


'First part of test: generation and printing:
'===================
If kRun1stPart Then
    s = "-------------------------------------------"
    Print #1, s
    Print #1, "First part of test: generation and printing"
    Print #1, s
    Print #1, ""
    
    init_by_array init, length
    s = "SEED:  initialization by array of " & Trim(length) & " elements"
    s = s & " (same as in the original C code)"
    Print #1, s
    MtArTest kMaxNr1, kPrintEachNth1, kgenrand_int32, True
    
    Print #1, ""
End If


'Second part of test: time needed just for generation
'====================
If kRun2ndPart Then
    s = "----------------------------------------------------"
    Print #1, s
    Print #1, "Second part of test: time needed just for generation"
    Print #1, s
    Print #1, ""

    init_by_array init, length
    
    aa = genrand_int32():
    sec1 = Timer
    For ii = 1 To kMaxNr2
        bb = genrand_int32()
    Next
    sec2 = Timer
    TestN = TestN + kMaxNr2 + 1
    
    Print #1, "Elapsed time in seconds for generating"; (kMaxNr2 + 1); _
              "numbers and printing 2 of them: "; GetSeconds(sec2 - sec1)
    Print #1, "Control numbers:   A=" & Trim(aa) & "   B=" & Trim(bb) & "   C=" & Trim(kMaxNr2 + 1)
    Print #1, "     A should be equal to 1067595299"
    If (kMaxNr2 = 100000000) Then
        Print #1, "     B should be equal to 2891345831 if C is 100000001";
    ElseIf (kMaxNr2 = 10000000) Then
        Print #1, "     B should be equal to 2982969678 if C is 10000001";
    Else
        Print #1, "     B should be equal to 3661023188 if C is 1000001";
        If (kMaxNr2 <> 1000000) Then Print #1, ", or usually different otherwise";
    End If
    Print #1, ""
    Print #1, "     (A is the first and B is the last of C pseudorandom numbers generated)"
    
    TestP = TestP + 2 'for A and B
    Print #1, ""
    Print #1, ""
    Print #1, ""
End If


'Third part of test: Generate numbers with different seeds
'===================
If kRun3rdPart Then
    s = "--------------------------------------------------------------"
    Print #1, s
    Print #1, "Third part of test: Generation of numbers with different seeds"
    Print #1, s
    Print #1, ""
    
    seed = kDefaultSeed: init_genrand seed
    s = "SEED:  default = " & Trim(seed)
    Print #1, s
    MtArTest kMaxNr3, kPrintEachNth3, kgenrand_int32, False
    
    seed = k2_31Neg: init_genrand seed: s = "SEED:  -2^31 = " & Trim(seed): Print #1, s
    MtArTest kMaxNr3, kPrintEachNth3, kgenrand_int32, False
    
    seed = k2_31Neg + 1: init_genrand seed: s = "SEED:  -2^31+1 = " & Trim(seed): Print #1, s
    MtArTest kMaxNr3, kPrintEachNth3, kgenrand_int32, False
    
    seed = -2: init_genrand seed: s = "SEED:  " & Trim(seed): Print #1, s
    MtArTest kMaxNr3, kPrintEachNth3, kgenrand_int32, False
    
    seed = -1: init_genrand seed: s = "SEED:  " & Trim(seed): Print #1, s
    MtArTest kMaxNr3, kPrintEachNth3, kgenrand_int32, False
    
    seed = 0: init_genrand seed: s = "SEED:  " & Trim(seed): Print #1, s
    MtArTest kMaxNr3, kPrintEachNth3, kgenrand_int32, False
    
    seed = 1: init_genrand seed: s = "SEED:  " & Trim(seed): Print #1, s
    MtArTest kMaxNr3, kPrintEachNth3, kgenrand_int32, False
    
    seed = 2: init_genrand seed: s = "SEED:  " & Trim(seed): Print #1, s
    MtArTest kMaxNr3, kPrintEachNth3, kgenrand_int32, False
    
    seed = k2_31b - 1: init_genrand seed: s = "SEED:  2^31-2 = " & Trim(seed): Print #1, s
    MtArTest kMaxNr3, kPrintEachNth3, kgenrand_int32, False
    
    seed = k2_31b: init_genrand seed: s = "SEED:  2^31-1 = " & Trim(seed): Print #1, s
    MtArTest kMaxNr3, kPrintEachNth3, kgenrand_int32, False

    init_by_array init, length
    s = "SEED:  initialization by array of " & Trim(length) & " elements, equal to { 0x123, 0x234, 0x345, 0x456 } ."
    Print #1, s
    Print #1, ""
    s = "       IT IS THE SAME TEST AS THE ONE IN THE ORIGINAL C CODE, "
    Print #1, s
    Print #1, "       but prints only ";
    MtArTest kMaxNr3, kPrintEachNth3, kgenrand_int32, False
    
    init_by_array init2, length
    s = "SEED:  initialization by array of " & Trim(length) & " elements, equal to { 0x123, 0x234, 0x345, 0x457 } ."
    Print #1, s
    Print #1, ""
    s = "       The initialization array differs from the one in the original C code, "
    Print #1, s
    Print #1, "       in JUST THE LAST BIT. Prints only ";
    MtArTest kMaxNr3, kPrintEachNth3, kgenrand_int32, False
    
    init_by_array init3, length
    s = "SEED:  initialization by array of " & Trim(length) & " elements,"
    Print #1, s
    s = "       each one equal to 0 ."
    Print #1, s
    MtArTest kMaxNr3, kPrintEachNth3, kgenrand_int32, False
    
    init_by_array init4, length
    s = "SEED:  initialization by array of " & Trim(length) & " elements, "
    Print #1, s
    s = "       each one equal to 0xFFFFFFFF == 2^32-1 == 4294967295 ."
    Print #1, s
    MtArTest kMaxNr3, kPrintEachNth3, kgenrand_int32, False
    
    Print #1, ""
End If


'Fourth part of test: Generate real numbers
'====================
If kRun4thPart Then
    s = "-------------------------------------------------------"
    Print #1, s
    Print #1, "Fourth part of test: Generation using all the functions"
    Print #1, s
    Print #1, ""
    
    Print #1, ""
    Print #1, "** FUNCTIONS THAT RETURN AN INTEGER VALUE:"
    Print #1, ""
    Print #1, ""
    
    seed = kDefaultSeed: init_genrand seed
    s = "SEED:  default = " & Trim(seed)
    Print #1, s
    Print #1, ""
    MtArTest kMaxNr4, kPrintEachNth4, kgenrand_int32, False
    
    seed = kDefaultSeed: init_genrand seed
    s = "SEED:  default = " & Trim(seed) & " (same seed as before, to compare the different values returned)"
    Print #1, s
    Print #1, ""
    MtArTest kMaxNr4, kPrintEachNth4, kgenrand_int31, False
    
    
    Print #1, ""
    Print #1, "** FUNCTIONS THAT RETURN A REAL VALUE:"
    Print #1, ""
    Print #1, ""
    
    s = "SEED:  NO NEW SEEDS ARE USED in the remaining tests of this 4th section. "
    Print #1, s
    s = "       The last one (default=" & Trim(seed) & ") remains valid and is not reset between consecutive tests."
    Print #1, s
    Print #1, ""
    Print #1, ""
    
    MtArTest kMaxNr4, kPrintEachNth4, kgenrand_real1, False
    MtArTest kMaxNr4, kPrintEachNth4, kgenrand_real2, False
    MtArTest kMaxNr4, kPrintEachNth4, kgenrand_real3, False
    MtArTest kMaxNr4, kPrintEachNth4, kgenrand_res53, False
    
    Print #1, ""
    Print #1, "** FUNCTIONS THAT ARE PRESENT ONLY IN THE VISUAL BASIC VERSION "
    Print #1, "   WITH NO COUNTERPART IN THE ORIGINAL C VERSION:"
    Print #1, ""
    Print #1, ""
    MtArTest kMaxNr4, kPrintEachNth4, kgenrand_int32SignedLong, False
    MtArTest kMaxNr4, kPrintEachNth4, kgenrand_real2b, False
    MtArTest kMaxNr4, kPrintEachNth4, kgenrand_real2c, False
    MtArTest kMaxNr4, kPrintEachNth4, kgenrand_real3b, False
    MtArTest kMaxNr4, kPrintEachNth4, kgenrand_real4b, False
    MtArTest kMaxNr4, kPrintEachNth4, kgenrand_real5b, False

    Print #1, ""
End If

secB = Timer


s = "=========================================================="
Print #1, s
Print #1, Tit1
Print #1, Tit2
Print #1, ""
Print #1, "TOTAL AMOUNT of pseudorandom numbers generated"
Print #1, "                 in all the previous tests: " & Trim(TestN)
Print #1, "                                   printed: " & Trim(TestP)
Print #1, "ELAPSED TIME in seconds for the full test : " & GetSeconds(secB - secA)
Print #1, s

Close #1    'close the output file

End Sub     'MtArFullTest



'To run this full test you must first delete the main() function provided by the
'authors of the Mersenne Twister algorithm and that, in the example given in the
'"Usage" section (see step 1), is present in the VBA module that we called "mt19937ar".
'Then, either rename the above function MtArFullTest() as main(), or uncomment and
'run the main() below:
'
'Sub main()
'MtArFullTest
'End Sub 'main
