Visual Basic for Applications/VBA 的 PRNG
- 伪随机数生成器 (PRNG) 如果运行足够长的时间，会生成一个基于其算法的特征序列。这个序列永远重复，而且是不变的。VBA 的 Rnd() 函数，如果在循环中使用，不带参数，也不使用 Randomize()，将生成 16,777,216 个介于零和一之间的值，然后从头开始，生成一个周期长度为 16,777,216 的重复序列。用户唯一的选择是选择该序列中的起点。这是通过选择一个 开始 值或 种子 来完成的。在 Rnd() 的情况下，开始值通过两种方式选择：默认情况下，使用系统计时器，或者使用用户设置的数字。同样，用户设置的开始参数不会生成新的序列，只会决定该序列中的哪一部分将被使用。线性同余生成器 (LCG)，即 Microsoft 的 Rnd() 函数使用的类型，在 线性同余生成器 中有详细描述。
- 单级 LCG 的最大周期长度等于其模数。对于组合生成器，最大周期长度等于各个生成器的周期长度的最小公倍数。设计良好的生成器将具有最大周期长度，并且在其整个序列中只包含唯一的值，但并非所有生成器都是设计良好的。上面的链接描述了设计 LCG 所需的值，以便其在所有起始值上都具有最大周期长度。
- 下面的代码模块包含 VBA 中的 Wichmann-Hill (1982) CLCG (组合 LCG)，并且完全可用。它被称为 RndX()，并与它自己的 RandomizeX() 配合使用。它比 Microsoft 的 Rnd() 具有更长的重复周期。下面给出了 RndX() 的最有用设置的摘要，以及那些需要更多细节的人在下拉框中的额外信息。遗憾的是，作者缺乏进行任何严肃的数字生成器测试的工具和知识，因此以下内容可能只对初学者感兴趣。
- 长周期生成器在 Excel 中难以研究。Microsoft 的 Rnd() 和用户函数 RndX() 的周期都太长，无法将完整周期写入单个工作表列中。解决方案是只列出长流的一部分，或者创建一个周期足够短以供完整列出的数字生成器。以这种方式在单个列中列出，可以确认重复周期的长度，然后在删除重复项后修剪行，然后计算删除重复项后的行数，可以向怀疑者确认所有值都是唯一的。模块中包含了一些过程，用于列出 Wichmann-Hill 实现的一部分，它适合大约 30269 行左右，以及另一个非常简单的生成器，用于进一步测试，它只适合 43 行。
微软的 Visual Basic for Applications (VBA)，目前在 Rnd() 函数中使用线性同余生成器 (LCG) 进行伪随机数生成。由于溢出，尝试在 VBA 中实现 Microsoft 算法失败。以下是其基本算法。
x1 = ( x0 * a + c ) MOD m
and;
Rnd() = x1/m
where:
Rnd() = returned value
m = modulus = (2^24)
x1 = new value
x0 = previous value (initial value 327680)
a = 16598013
c = 12820163
Repeat length = m = (2^24) = 16,777,216
可以注意到 Microsoft 的 Rnd() 与下面由 Wichmann-Hill (1982) 描述的算法之间的相似之处，其中三个 LCG 表达式的总和用于生成每个输出数字。表达式的组合给出了 RndX()，其编码值具有其大大改善的循环长度，为
Cycle length = least_common_multiple(30268, 30306, 30322) = 30268 * 30306 * 30322 / 4 = 6,953,607,871,644
关于模块级变量的提醒可能是有序的。模块级变量在过程运行之间保持其值。实际上，它们将保留值，直到 VBA 不再使用或代码被编辑。代码中已加入这些变量的重置，以确保从预期的值开始，而不是从之前的顶级过程运行的旧存储值开始。
注意：虽然该算法比驻留的 Rnd() 具有改进的属性，但运行这些生成器的应用程序本身并不特别安全。还要考虑，如果起始值已知，则所有 LCG 编码的输出都是完全可预测的。实际上，如果已知该流的任何部分，那么那些有意伤害的人可以通过将其与存储的值进行比较来找到整个流。这些事实加在一起限制了此类 VBA 实现的使用范围，仅限于学习或非关键应用程序。
话虽如此，以下可能是最实用的参数配置：在每种情况下，RandomizeX() 应该只调用一次，在调用 RndX() 之前，并且在任何包含 RndX() 的生成器循环之外。此建议也适用于 Microsoft 函数 Rnd() 及其配套函数 Randomize()。
- 要生成具有不可预测起始点的输出，以及每次运行时不同的起始点
- 在调用 RndX 之前，调用 RandomizeX，不带任何参数。这使用了系统计时器。
- 要从大量可重复的起始点生成输出，并且由用户参数选择
- 在调用 RndX 之前，调用 RandomizeX，使用任何数字参数。更改 RandomizeX 参数值会导致标准算法流的不同起始点。
- 要生成不可预测的单个值，每次运行时都不同
- 在调用 RndX 之前，调用 RandomizeX，不带任何参数，并使用参数为零。这使用了系统计时器。
- 要生成可重复的单个值，与用户参数相关，并由用户参数选择
- 在调用 RndX 之前，调用 RandomizeX，使用任何数字参数，并使用参数为零。更改 RandomizeX 参数值会导致不同的值，这些值对每个参数都是特有的。
- 请参考下面的下拉框，获取参数设置及其结果的完整列表。
|
本节中的代码应另存为 Excel 中的单独标准模块。
Option Explicit
Dim nSamples As Long
Dim nX As Long, nY As Long, nZ As Long
Sub TestRndX()
'run this to obtain RndX() samples
'Wichmann, Brian; Hill, David (1982), Algorithm AS183:
'An Efficient and Portable Pseudo-Random Number Generator,
'Journal of the Royal Statistical Society. Series C
Dim n As Long
'reset module variables
nX = 0: nY = 0: nZ = 0
RandomizeX
For n = 1 To 10
Debug.Print RndX()
MsgBox RndX()
Next n
'reset module variables
nX = 0: nY = 0: nZ = 0
End Sub
Sub TestScatterChartOfPRNG()
'run this to make a point scatter chart
'using samples from RndX
Dim vA As Variant, n As Long
Dim nS As Long, nR As Double
'remove any other charts
'DeleteAllCharts
'reset module variables
nX = 0: nY = 0: nZ = 0
'set number of samples here
nSamples = 1000
ReDim vA(1 To 2, 1 To nSamples) 'dimension array
'load array with PRNG samples
RandomizeX
For n = 1 To nSamples
nR = RndX()
vA(1, n) = n 'x axis data - sample numbers
vA(2, n) = nR 'y axis data - prng values
Next n
'make scatter point chart from array
ChartScatterPoints vA, 1, 2, nSamples & " Samples of RndX()", _
"Sample Numbers", "PRNG Values [0,1]"
'reset module work variables
nX = 0: nY = 0: nZ = 0
End Sub
Sub RandomizeX(Optional ByVal nSeed As Variant)
'sets variables for PRNG procedure RndX()
Const MaxLong As Double = 2 ^ 31 - 1
Dim nS As Long
Dim nN As Double
'make multiplier
If IsMissing(nSeed) Then
nS = Timer * 60
Else
nN = Abs(Int(Val(nSeed)))
If nN > MaxLong Then 'no overflow
nN = nN - Int(nN / MaxLong) * MaxLong
End If
nS = nN
End If
'update variables
nX = (nS Mod 30269)
nY = (nS Mod 30307)
nZ = (nS Mod 30323)
'avoid zero state
If nX = 0 Then nX = 171
If nY = 0 Then nY = 172
If nZ = 0 Then nZ = 170
End Sub
Function RndX(Optional ByVal nSeed As Long = 1) As Double
'PRNG - gets pseudo random number - use with RandomizeX
'Wichmann-Hill algorithm of 1982
Dim nResult As Double
'initialize variables
If nX = 0 Then
nX = 171
nY = 172
nZ = 170
End If
'first update variables
If nSeed <> 0 Then
If nSeed < 0 Then RandomizeX (nSeed)
nX = (171 * nX) Mod 30269
nY = (172 * nY) Mod 30307
nZ = (170 * nZ) Mod 30323
End If
'use variables to calculate output
nResult = nX / 30269# + nY / 30307# + nZ / 30323#
RndX = nResult - Int(nResult)
End Function
Sub ChartScatterPoints(ByVal vA As Variant, RowX As Long, RowY As Long, _
Optional sTitle As String = "", Optional sXAxis As String, _
Optional sYAxis As String)
'array input must contain two data rows for x and y data
'parameters for user title, x axis and y axis labels
'makes a simple point scatter chart
Dim LBC As Long, UBC As Long, LBR As Long, UBR As Long, n As Long, bOptLim As Boolean
Dim X As Variant, Y As Variant, sX As String, sY As String, sT As String, oC As Chart
LBR = LBound(vA, 1): UBR = UBound(vA, 1)
LBC = LBound(vA, 2): UBC = UBound(vA, 2)
ReDim X(LBC To UBC)
ReDim Y(LBC To UBC)
'labels for specific charts
If sTitle = "" Then sT = "Title Goes Here" Else sT = sTitle
If sXAxis = "" Then sX = "X Axis Label Goes Here" Else sX = sXAxis
If sYAxis = "" Then sY = "Y Axis Label Goes Here" Else sY = sYAxis
If RowX < LBR Or RowX > UBR Or RowY < LBC Or RowY > UBC Then
MsgBox "Parameter data rows out of range in ChartColumns - closing"
Exit Sub
End If
'transfer data to chart arrays
For n = LBC To UBC
X(n) = vA(RowX, n) 'x axis data
Y(n) = vA(RowY, n) 'y axis data
Next n
'make chart
Charts.Add
'set chart type
ActiveChart.ChartType = xlXYScatter 'point scatter chart
'remove unwanted series
With ActiveChart
Do Until .SeriesCollection.Count = 0
.SeriesCollection(1).Delete
Loop
End With
'assign the data and labels to a series
With ActiveChart.SeriesCollection
If .Count = 0 Then .NewSeries
If Val(Application.Version) >= 12 Then
.Item(1).Values = Y
.Item(1).XValues = X
Else
.Item(1).Select
Names.Add "_", X
ExecuteExcel4Macro "series.x(!_)"
Names.Add "_", Y
ExecuteExcel4Macro "series.y(,!_)"
Names("_").Delete
End If
End With
'apply title string, x and y axis strings, and delete legend
With ActiveChart
.HasTitle = True
.ChartTitle.Text = sT
.SetElement (msoElementPrimaryCategoryAxisTitleAdjacentToAxis) 'X
.Axes(xlCategory).AxisTitle.Text = sX
.SetElement (msoElementPrimaryValueAxisTitleRotated) 'Y
.Axes(xlValue).AxisTitle.Text = sY
.Legend.Delete
End With
'trim axes to suit
With ActiveChart
'X Axis
.Axes(xlCategory).Select
.Axes(xlCategory).MinimumScale = 0
.Axes(xlCategory).MaximumScale = nSamples
.Axes(xlCategory).MajorUnit = 500
.Axes(xlCategory).MinorUnit = 100
Selection.TickLabelPosition = xlLow
'Y Axis
.Axes(xlValue).Select
.Axes(xlValue).MinimumScale = -0.2
.Axes(xlValue).MaximumScale = 1.2
.Axes(xlValue).MajorUnit = 0.1
.Axes(xlValue).MinorUnit = 0.05
End With
ActiveChart.ChartArea.Select
Set oC = Nothing
End Sub
Sub DeleteAllCharts5()
'run this to delete all ThisWorkbook charts
Dim oC
Application.DisplayAlerts = False
For Each oC In ThisWorkbook.Charts
oC.Delete
Next oC
Application.DisplayAlerts = True
End Sub
下面的代码模块包含 Wichmann-Hill (1982) 算法的简化版本，实际上只使用了其三个计算部分中的第一个。它将使用不同的起始值在运行它的工作簿的Sheet1 上生成多个完整的数值流。请注意，第一个值在第 30269 行都重复出现，如果扩展，整个流也会重复出现。生成列表后，使用电子表格的列排序和删除重复项函数来查看每列是否包含适当数量的唯一条目。还包含了一个更简单的生成器，其重复周期仅为 43，这可能使研究更易于管理，并且可以通过运行TestMSRnd 来查看 Microsoft 的Rnd() 的周期在 16777216 (+1) 处重复。
本节中的代码应另存为 Excel 中的单独标准模块。
Option Explicit
Private ix2 As Long
Sub TestWHRnd30269()
'makes five columns for complete output streams
'each with a different start point
'runs a simplified LCNG with mod 30269
Dim sht As Worksheet, nS As Double, nSamp As Long
Dim c As Long, r As Long, nSeed As Long
'set seed value for Rnd2()
nSeed = 327680 'WH initial seed
'set number of random samples to make
nSamp = 30275 '30269 plus say, 6
'set initial value of carry variable
ix2 = nSeed
Set sht = ThisWorkbook.Worksheets("Sheet1")
'clear the worksheet
sht.Cells.Cells.ClearContents
'load sheet with set of samples
For c = 1 To 5 'number of runs
ix2 = nSeed + c 'change start value
For r = 1 To nSamp 'number of samples
nS = WHRnd30269() 'get a sample
sht.Cells(r, c) = nS 'write to sheet
Next r
Next c
sht.Cells(1, 1).Select
End Sub
Function WHRnd30269() As Double
'first part of Wichmann-Hill tripple.
'When started with seed ix2 = 171,
'full sequence repeats from n = 30269
'without any repeated values before.
Dim r As Double
'ix2 cannot be 0.
If ix2 = 0 Then
ix2 = 171
End If
'calculate Xn+1 from Xn
ix2 = (171 * ix2) Mod 30269
'make an output value
r = ix2 / 30269#
WHRnd30269 = r - Int(r)
End Function
Sub TestSimpleRnd43()
'makes five columns for complete output streams
'each with a different start point
'runs a very simple LCNG with mod 43
Dim sht As Worksheet, nS As Double, nSamp As Long
Dim c As Long, r As Long, nSeed As Long
'set seed value for Rnd2()
nSeed = 17 'initial seed
'set number of random samples to make
nSamp = 45 '43 plus say, 2
'set initial value of carry variable
ix2 = nSeed
Set sht = ThisWorkbook.Worksheets("Sheet1")
'clear the worksheet
sht.Cells.Cells.ClearContents
'load sheet with set of samples
For c = 1 To 5 'number of runs
ix2 = nSeed + c 'change start value
For r = 1 To nSamp 'number of samples
nS = SimpleRnd43() 'get a sample
sht.Cells(r, c) = nS 'write to sheet
Next r
Next c
sht.Cells(1, 1).Select
End Sub
Function SimpleRnd43() As Double
'simple Lehmer style LCNG to show repeat streams
'produces one sequence of 42 unique values - then repeats entire sequence
'start value decides only where the predictable sequence begins
Dim r As Double
'Note; Makes 42 unique values before sequence repeats
'Modulus = 43: Multiplier = 5: Initial Seed = 17
'43 is prime
'5 is primitive root mod 43
'17 is coprime to 43
'ix2 cannot be 0.
If ix2 = 0 Then
ix2 = 17
End If
'calculate a new carry variable
ix2 = (5 * ix2) Mod 43
'make an output value
r = ix2 / 43#
SimpleRnd43 = r - Int(r)
End Function
Sub TestMSRnd()
'makes two sets of single data using MS Rnd
'the first 10 samples of Rnd() values
'followed by values around sample 16777216
'confirms sequence probably re-starts at M+1 = 16777217
Dim sht As Worksheet, nS As Double
Dim c As Long, r As Long, nMod As Long
'note modulus
nMod = 16777216
Set sht = ThisWorkbook.Worksheets("Sheet1")
'clear the worksheet
sht.Cells.Cells.ClearContents
'load sheet with set of samples
For r = 1 To nMod + 20 'number of samples
nS = Rnd() 'get a sample
Select Case r
Case 1 To 10
sht.Cells(r, 1) = r
sht.Cells(r, 2) = nS
Case (nMod - 4) To (nMod + 5)
sht.Cells(r - 16777211 + 10, 1) = r
sht.Cells(r - 16777211 + 10, 2) = nS
End Select
Next r
sht.Cells(1, 1).Select
End Sub
- Wichmann, Brian; Hill, David (1982), Algorithm AS183: An Efficient and Portable Pseudo-Random Number Generator, Journal of the Royal Statistical Society. Series C
- Wichmann-Hill CLCG: 关于该特定组合线性同余生成器的维基百科文章。
- 线性同余生成器: 维基百科对完全周期条件的良好描述。
- Visual Basic 如何为 RND 函数生成伪随机数: Microsoft kb231847 知识库条目