Visual Basic for Applications/A PRNG for VBA

From Wikibooks, open books for an open world
Jump to navigation Jump to search

Summary[edit]

  • Pseudo-random generators of the Microsoft's Rnd() type, if run for long enough, generate a characteristic sequence that is based on numbers chosen within their coding. Such a sequence is repeated in its entirety and is invariant. The Rnd() function of VBA, if placed in a loop without a parameter, and without making use of Randomize() at all, will generate 16777216 values between zero and unity, then start again at the beginning, making one identical sequence. The only option for the user is to choose the part of that one solitary sequence that he will use for the start of his sample list. This is done by choosing a start value or seed. In the case of Rnd(), the start value is chosen in various ways; by default, using the system timer, or with a user-set number. Again, the start parameters that are set by the user do not make new sequences, they just decide which bit of one long sequence will be used. Linear Congruential Number Generators (LCNG), the type used by Microsoft's Rnd() function are described in detail at Linear congruential generator.
  • The maximum cycle length for a single stage LCNG generator is equal to its modulus, and for combined algorithms it is roughly equal to the product of the moduli of the various stages. Whereas a well designed generator will have the maximum cycle length and consist only of unique values throughout its sequence, not all generators do this. The above link describes the design values required to make a generator with a maximum cycle over all of its starting values.
  • The code module below contains the Wichmann-Hill (1982) CLCNG (combined LCNG) in VBA, and is fully functional. It is called RndX(), and is used in conjunction with its own RandomizeX(). It has a much longer repeat cycle than Microsoft's Rnd(). A summary of the most useful settings for RndX() is given, with additional details for those who need them in a drop box. Sadly, this author lacks the tools and knowledge for any serious testing of number generators, so the offerings below are likely to be of interest to only beginners.
  • Long cycle generators are awkward to study in VBA. The lengths of both Microsoft's Rnd() and the user function RndX() are much too long to write to a single worksheet column. The solution is either to list only parts of long streams or to make a number generator with a cycle short enough for a full listing. Listing in a single column this way allows confirmation of the repeat cycle length, then after trimming the rows to a complete set, counting rows after the removal of duplicates will confirm for the skeptical that all of the values are unique. A module is included with procedures to list one section of the Wichmann-Hill implementation, that fits into about 30269 rows or so, and another with a very simple generator for further testing, that fits into just 43.

Microsoft's Rnd() algorithm[edit]

Microsoft's Visual Basic for Applications (VBA), at present uses a linear congruential generator (LCG) for pseudo-random number generation in the Rnd() function. Attempts to implement the Microsoft algorithm in VBA failed owing to overflow. The following is its basic algorithm.

      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 = 1140671485
      c = 12820163
      Repeat length = m = (2^24) = 16,777,216

Similarities will be noticed between Microsoft's Rnd() and the one below, described by Wichmann-Hill (1982), in which a sum of three LCG expressions is used in the production of each output number. The combination of expressions gives RndX(), with the coded values, its much improved cycle-repeat-length of about:

      Repeat length = m1 * m2 * m3 = 30269 * 30307 * 30323 = 27,817,185,604,309

VBA Code - Wichmann-Hill (1982)[edit]

A reminder about module level variables may be in order. Module level variables hold their values between procedure runs. In fact they will retain values until the VBA is no longer used at all or the code is edited. The code has been laced with resets for these variables, to ensure starting with intended values, as opposed to old stored ones from the previous top procedure runs.

On a cautionary note; although this algorithm has improved properties over the resident Rnd(), the applications on which these generators are run are not particularly secure. Consider also that the output of all LCNG coding is entirely predictable if the starting value is ever known. In fact, if any part of such a stream is known, then it is possible for those who intend harm to find the entire stream by comparing it with stored values. These facts when taken together limit the use of such a VBA implementation to study or non-critical applications.

That said, these are likely to be the most useful parameter configurations: In each case RandomizeX() should only be called once, before and outside any generator loop that contains RndX(). This advice also applies to the Microsoft function Rnd() and its companion Randomize().

  • To produce outputs with an unpredictable start point, and a different start point each time it is run:
    • Call RandomizeX without any parameter before calling RndX, also without any parameter. This uses the system timer.
  • To produce outputs from a large set of start points, repeatable, and chosen by a user parameter:
    • Call RandomizeX with any numeric parameter before calling RndX without any parameter. Changed RandomizeX parameter values result in different start points of the standard algorithm stream.
  • To produce an unpredictable, single value, different each time it is run:
    • Call RandomizeX without any parameter before calling RndX with a parameter of zero. This uses the system timer.
  • To produce a repeatable single value, related to, and chosen by a user parameter:
    • Call RandomizeX with any numeric parameter before calling RndX with a parameter of zero. Changed RandomizeX parameter values result in different values that are peculiar to each parameter.
  • Refer to the drop box below for a complete tabulation of the parameter settings and their outcomes.
PRNG RndX() and RandomizeX() Parameter Details
 
RndX() and RandomizeX() Parameter Details
RandomizeX()
parameter
RndX()
parameter
Behaviour of function
(assuming coding is to produce a sequence)
none. none PRNG stream determined by runtime sampling of the computer’s system timer. Stream uncertain.
none positive PRNG stream determined by runtime sampling of the computer’s system timer. Stream uncertain. Positive parameters of RndX() do not affect it at all.
none negative One number, repeatable, and each one different and depending on the value of RndX() parameter.
Example; RndX(-3) leads to 0.05079271
none zero One number, repeatable, decided by runtime sampling of the computer’s system timer;
Example; sequence is 0.1741…, 01741…
numeric2 none PRNG stream, repeatable, and each one different and depending on the value of RandomizeX() parameter.
numeric positive PRNG stream, repeatable, and each one different and depending on the value of RandomizeX() parameter. Positive parameters of RndX() do not affect it at all.
numeric negative One number, repeatable, and each one different and depending on the value of RndX() parameter. The RandomizeX() parameter value has no effect at all.
Example; RndX(-51) leads to 0.8634…
numeric zero One number, repeatable, and each one different and depending on the value of RandomizeX() parameter.
Example; RandomizeX(2346) leads to 0.2322…
function
not used
none Default PRNG stream, repeatable, and always same.
Example; sequence is 0.8952…, 0.1114…, 0.9395…
function
not used
positive Default PRNG stream, repeatable, and always same.
Example; sequence is 0.8952…, 0.1114…, 0.9395…
function
not used1
negative
or zero
One number, repeatable, and each one different and depending on the value of RndX() parameter.
Example; RndX(0) = 0.8694...: -5 = 0.0846…


1. The term Function not used is intended to mean that the function is not specifically called in code by the user. In some cases, for example this one, the RandomizeX() function still needs to be available in code for the RndX() function's internal call.
2. Numeric items are those that can be made into a number. The RandomizeX() function produces a positive integer using the seed value given in its variant parameter. It does this for any leading part of a string also, right up to the first character that cannot be recognized as numeric.

Padding.gif

Padding.gif


The code in this section should be saved as a separate standard module in 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

Simpler Tests of PRNGs[edit]

The code module below contains a stripped down version of the Wichmann-Hill (1982) algorithm, in fact using only the first of its three calculated sections. It will make several complete streams of values on Sheet1 of the workbook in which it is run, using different start values. Notice that the first values are all repeated at row 30269, as will the whole stream if extended. After producing the list, use the spreadsheet's functions for column sorting and the removal of duplicates to see that each column contains the appropriate number of unique entries. An even simpler generator with a repeat cycle of just 43 is also included that might make study more manageable, and the cycle of Microsoft's Rnd() can be seen to repeat at 16777216 (+1) by running TestMSRnd.

The code in this section should be saved as a separate standard module in 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

References[edit]

  • Wichmann, Brian; Hill, David (1982), Algorithm AS183: An Efficient and Portable Pseudo-Random Number Generator, Journal of the Royal Statistical Society. Series C

See Also[edit]

External Links[edit]