A PRNG for VBA

Visual Basic for Applications · Wikibooks

0%

Contents

    Text

    Size
    100%
    Theme
    Typeface
    Line length
    Spacing

    From Wikibooks, under CC BY-SA 4.0, as the source states it. This page at Wikibooks.

    A PRNG for VBA

    Summary

    • A pseudo-random number generator (PRNG), if run for long enough, generates a characteristic sequence that is based on its algorithm. This sequence repeats forever 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 16,777,216 values between zero and unity, then start again at the beginning, making a repeating sequence with a cycle length of 16,777,216. The only option for the user is to choose the starting point within that one sequence. This is done by choosing a start value or seed. In the case of Rnd(), the start value is chosen in two 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 that one long sequence will be used. Linear Congruential Generators (LCG), the type used by Microsoft's Rnd() function are described in detail at Linear congruential generator.
    • The maximum cycle length for a single stage LCG is equal to its modulus. For combined generators, the maximum cycle length is equal to the least common multiple of the cycle lengths of the individual generators. A well-designed generator will have the maximum cycle length and consist only of unique values throughout its sequence, but not all generators are well-designed. The above link describes the design values required to make an LCG with a maximum cycle length over all of its starting values.
    • The code module below contains the Wichmann-Hill (1982) CLCG (combined LCG) 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 only to beginners.
    • Long-cycle generators are awkward to study in Excel. The cycles of both Microsoft's Rnd() and the user function RndX() are much too long to write a complete cycle 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

    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 = 16598013
          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 length of:

          Cycle length = least_common_multiple(30268, 30306, 30322) = 30268 * 30306 * 30322 / 4 = 6,953,607,871,644
    

    VBA Code - Wichmann-Hill (1982)

    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 LCG 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.

    Illustration

    Illustration


    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

    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

    • 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