' VBA の MyRnd(), MyRandomize(), SRnd(), Back(), Jump() のテスト
Option Explicit
Private Type Doub1: x As Double: End Type
Private Type Byte8: x(0 To 7) As Byte: End Type
#If Win64 Then
Private Type LgLg1: x As LongLong: End Type
#End If
Public Sub RndSpeedTest()
Dim i&, j&, k&, iter&, line&, clo#, min#, sum#
Const MBYTE = 0.000008
Range("A:J").Delete: DoEvents
sum = 0: [A1] = "RNG Name": [B1] = "Iteration": [C1] = " Speed"
line = 2: iter = 10000000: Cells(line, "A") = "Rnd":
min = 32767: Cells(line, "B") = iter
For i = 1 To 10
Cells(line, "C") = "' " & CStr(i) & "0%": clo = Timer
For k = 1 To iter: sum = sum + Rnd(): Next
clo = Timer - clo
If (clo < min) And (clo > 0) Then min = clo
Next i
Cells(line, "C") = " " & Format$(MBYTE * iter / min, "0.0") & " MB/s"
line = 3: iter = 3000000: Cells(line, "A") = "MyRnd":
min = 32767: Cells(line, "B") = iter
For i = 1 To 10
Cells(line, "C") = "' " & CStr(i) & "0%": clo = Timer
For k = 1 To iter: sum = sum + MyRnd(): Next
clo = Timer - clo
If (clo < min) And (clo > 0) Then min = clo
Next i
Cells(line, "C") = " " & Format$(MBYTE * iter / min, "0.#0") & " MB/s"
line = 4: iter = 5000: Cells(line, "A") = "[RAND()]":
min = 32767: Cells(line, "B") = iter
For i = 1 To 10
Cells(line, "C") = "' " & CStr(i) & "0%": clo = Timer
For k = 1 To iter: sum = sum + [RAND()]: Next
clo = Timer - clo
If (clo < min) And (clo > 0) Then min = clo
Next i
Cells(line, "C") = " " & Format$(MBYTE * iter / min, "0.##0") & " MB/s"
line = 5: iter = 1000000: Cells(line, "A") = "Back":
min = 32767: Cells(line, "B") = iter
For i = 1 To 10
Cells(line, "C") = "' " & CStr(i) & "0%": clo = Timer
For k = 1 To iter: sum = sum + Back(): Next
clo = Timer - clo
If (clo < min) And (clo > 0) Then min = clo
Next i
Cells(line, "C") = " " & Format$(MBYTE * iter / min, "0.#0") & " MB/s"
Range("A1").Select
MsgBox "Done"
End Sub
Public Sub ComparisonTest()
Dim i As Long: MySRnd (0): MyRandomize
Range("A:J").Delete: DoEvents
[A1] = "Rnd()": [B1] = "MyRnd()": [C1] = "diff": MyRandomize
For i = 2 To 25
Cells(i, "A") = Rnd()
Cells(i, "B") = MyRnd()
Cells(i, "C") = Cells(i, 1) - Cells(i, 2)
Next i
End Sub
Public Sub SRndTest()
Dim i, line, err, myerr As Long
Range("A:J").Delete: DoEvents
err = 0: myerr = 0: Randomize
[A1] = "SRnd(*)": [B1] = "Rnd(0)": [C1] = "MyRnd(0)"
[A2] = 0: [A3] = 16777215
For i = 4 To 16: Cells(i, "A") = Rnd() * 16777216: Next
For i = 2 To 16
MySRnd CLng(Cells(i, "A"))
Cells(i, "B") = Rnd(0) * 16777216
Cells(i, "C") = MyRnd(0) * 16777216
Next i
DoEvents: line = 17: Cells(line, "A") = "Test All"
For i = 0 To 16777215
MySRnd i
If i <> Rnd(0) * 16777216 Then
err = err + 1: MsgBox "err:" & CStr(i): Exit For
End If
If i <> MyRnd(0) * 16777216 Then
myerr = myerr + 1: MsgBox "myerr:" & CStr(i): Exit For
End If
If (i And 1048575) = 1048575 Then
Cells(line, "B") = "' " & Format(i / 167772.15, "0.0") & " %"
End If
Next i
Cells(line, "B") = "Rnd(0)"
If err = 0 Then Cells(line, "C") = "OK" Else Cells(line, "C") = "NG"
Cells(line + 1, "B") = "MyRnd(0)"
If myerr = 0 Then Cells(line + 1, "C") = "OK" Else Cells(line + 1, "C") = "NG"
MsgBox "Done"
End Sub
Public Sub BackTest()
Dim i As Long: Range("A:J").Delete: DoEvents: SRnd 0: Randomize
[A1] = "Rnd": [B1] = "Back"
For i = 16 To 2 Step -1: Cells(i, "A") = Rnd(): Next i
For i = 2 To 16: Cells(i, "B") = Back(): Next i
End Sub
Public Sub JumpTest()
Dim i, k, n As Long
Range("A:J").Delete: DoEvents
[A1] = "num": [B1] = "F-Loop": [C1] = "F-Jump"
[D1] = "B-Loop": [E1] = "B-Jump"
Randomize
For i = 2 To 18
n = CLng((Rnd() * 16777216) Mod 100000)
Cells(i, "A") = n
SRnd 1: For k = 1 To n: Call Rnd: Next: Cells(i, "B") = Rnd
SRnd 1: Jump (n): Cells(i, "C") = Rnd
SRnd 1: For k = 1 To n: Call Back: Next: Cells(i, "D") = Back
SRnd 1: Jump (-n): Cells(i, "E") = Back
Next
End Sub