Results 1 to 25 of 25

Thread: Wichmann-Hill Pseudo Random Number Generator: an alternative for VB Rnd() function

  1. #1

    Thread Starter
    Head Hunted anhn's Avatar
    Join Date
    Aug 2007
    Location
    Australia
    Posts
    3,669

    Wichmann-Hill Pseudo Random Number Generator: an alternative for VB Rnd() function

    The native VB Rnd() function can generate a sequence of upto only 16,777,216 numbers before they are repeated. This is adequate in most cases but some projects may require many more numbers.

    Below is what I wrote in Excel (can be used in VB except the TestSub) based on the algorithm developed by B.A. Wichman and I.D. Hill that is implemented in Excel 2003 for WorksheetFunction RAND().

    As said, this algorithm guarantees to provide a sequence of more than 10,000,000,000,000 (10^13) numbers before they are repeated.

    I am happy with everyone's input to make this function better and faster.

    Please point out any problem you see.

    On my PC, withExcel 2003, it can generate 1 million numbers in every around 550 milliseconds (including time for storing values.)

    Put the top 3 Code blocks in one module and the test Sub in another module.
    Have fun!

    Code:
    '====================================================================================
    'http://support.microsoft.com/kb/828795
    '
    'The basic idea is that if you take three random numbers on [0,1] and sum them,
    'the fractional part of the sum is itself a random number on [0,1].
    'The critical statements in the Fortran code listing from the original
    'Wichman and Hill article are:
    '
    'C  IX, IY, IZ SHOULD BE SET TO INTEGER VALUES BETWEEN 1 AND 30000 BEFORE FIRST ENTRY
    'IX = MOD(171 * IX, 30269)
    'IY = MOD(172 * IY, 30307)
    'IZ = MOD(170 * IZ, 30323)
    'RANDOM = AMOD(FLOAT(IX) / 30269.0 + FLOAT(IY) / 30307.0 + FLOAT(IZ) / 30323.0, 1.0)
    '====================================================================================
    Option Explicit
    Private ix As Long, iy As Long, iz As Long
    Code:
    Sub RandomizeX(Optional ByVal Number)
       Const MaxLong As Double = 2 ^ 31 - 1
       Dim n As Long
       Dim d As Double
       
       If IsMissing(Number) Then
          n = Timer * 60
          '-- Timer is only updated in every 1/60th second.
          '-- Multiply by 60 to reduce the chance of seed
          '-- to be repeated in subsequence calls of RandomizedX
       Else
          d = Abs(Int(Val(Number)))
          If d > MaxLong Then '-- prevent Long overflow
             d = d - Int(d / MaxLong) * MaxLong
          End If
          n = d
       End If
       ix = (n Mod 30269)
       iy = (n Mod 30307)
       iz = (n Mod 30323)
       '-- ix, iy, iz cannot be 0
       If ix = 0 Then ix = 171
       If iy = 0 Then ix = 172
       If iz = 0 Then ix = 170
    End Sub
    Code:
    Function RndX(Optional ByVal Number As Long = 1) As Double
       Dim r As Double
       
       If ix = 0 Then '-- ix, iy, iz cannot be 0.
          ix = 171    '-- Initial values of ix, iy and iz are 0.
          iy = 172    '-- If any of these equal 0,
          iz = 170    '-- it will be stucked with 0 forever.
       End If
       If Number <> 0 Then
          If Number < 0 Then
             RandomizeX Number
          End If
          ix = (171 * ix) Mod 30269 '-- This has been tested:
          iy = (172 * iy) Mod 30307 '-- ix, iy, iz will never be 0.
          iz = (170 * iz) Mod 30323 '-- ---------------------------
       End If
       r = ix / 30269# + iy / 30307# + iz / 30323#
       RndX = r - Int(r)
    End Function
    Run TestRndX(). If you want to stop, use Ctrl-Break then un-remark 'Exit Do
    then let the Sub continues to exit properly to reset ScreenUpdating.

    Code:
    Option Explicit
    Private Declare Function GetTickCount Lib "kernel32" () As Long
    
    Sub TestRndX()
       Dim r0 As Double
       Dim r As Double
       Dim rMin As Double
       Dim rMax As Double
       Dim rSum As Double
       Dim rAvg As Double
       Dim TenPctCount(0 To 9) As Double
       Dim p As Integer
       Dim n As Long
       Dim m As Long
       Dim t As Double
       Dim aCell As Range
       Dim CellRow As Long
       Const BottomRow = 65536
       Const Million = 1000000
       Dim Headers As Variant
       Dim ColWidths As Variant
       
       '----- Prepare Sheet for report ---------------------------------------
       Headers = Array("Count", "Cur Rnd", "millisecs", "Min", "Max", "Avg", _
                       "<0.1", "<0.2", "<0.3", "<0.4", "<0.5", _
                       "<0.6", "<0.7", "<0.8", "<0.9", "<1.0")
       ColWidths = Array(15, 18, 8, 18, 18, 18, _
                         13, 13, 13, 13, 13, 13, 13, 13, 13, 13)
       With Sheet1
          For p = 0 To UBound(Headers)
             .Cells(1, p + 1).ColumnWidth = ColWidths(p)
          Next
          .Range(.Cells(1, 1), .Cells(1, 16)) = Headers
          .Range("A:A,C:C,G:P").NumberFormat = "#,##0"
          .Range("B:B,D:F").NumberFormat = "0.000000000000000"
       '-----------------------------------------------------------------------
          RandomizeX
          r0 = RndX '---- FIRST Random Number
          rMin = r0
          rMax = r0
          rSum = r0
          rAvg = r0
          CellRow = 2
          .Cells(CellRow, 1) = 0
          .Cells(CellRow, 2) = r0
          Application.ScreenUpdating = False
          Do While CellRow < BottomRow
             '=========================
             'Exit Do '-- Un-remark this after Control-Break then let
                      '   the Sub continue to reset ScreenUpdating
             '=========================
             t = GetTickCount
             For n = 1 To Million
                r = RndX
                If rMin > r Then rMin = r
                If rMax < r Then rMax = r
                rSum = rSum + r
                p = Int(r * 10)
                TenPctCount(p) = TenPctCount(p) + 1
                If r = r0 Then
                   .Cells(CellRow, 1) = m * Million + n
                   .Cells(CellRow, 2) = r
                   .Cells(CellRow, 3) = "Repeated!"
                   Exit Do
                End If
             Next
             t = GetTickCount - t
             m = m + 1
             CellRow = CellRow + 1
             .Cells(CellRow, 1) = CDbl(m) * Million
             .Cells(CellRow, 2) = r
             .Cells(CellRow, 3) = t
             .Cells(CellRow, 4) = rMin
             .Cells(CellRow, 5) = rMax
             .Cells(CellRow, 6) = rSum / (CDbl(m) * Million) '-- rAvg
             For p = 0 To 9
                .Cells(CellRow, 7 + p) = TenPctCount(p)
             Next
             If m Mod 10 = 0 Then
                Application.ScreenUpdating = True
                ActiveWindow.ScrollRow = CellRow - 10
                DoEvents
                Application.ScreenUpdating = False
             End If
          Loop
       End With
       Application.ScreenUpdating = True
    End Sub
    Last edited by anhn; Dec 7th, 2007 at 05:31 AM.

  2. #2
    VB6, XHTML & CSS hobbyist Merri's Avatar
    Join Date
    Oct 2002
    Location
    Finland
    Posts
    6,654

    Re: Wichman-Hill Pseudo Random Number Generator: an alternative for VB Rnd() function

    Here is a suggestion for independent function. It doesn't work exactly the same, but I paid a lot attention to details on how it works.

    Code:
    Public Function RndM(Optional ByVal Number As Long) As Double
        Static lngX As Long, lngY As Long, lngZ As Long, blnInit As Boolean
        Dim dblRnd As Double
        ' if initialized and no input number given
        If blnInit And Number = 0 Then
            ' lngX, lngY and lngZ will never be 0
            lngX = (171 * lngX) Mod 30269
            lngY = (172 * lngY) Mod 30307
            lngZ = (170 * lngZ) Mod 30323
        Else
            ' if no initialization, use Timer, otherwise ensure positive Number
            If Number = 0 Then Number = Timer * 60 Else Number = Number And &H7FFFFFFF
            lngX = (Number Mod 30269)
            lngY = (Number Mod 30307)
            lngZ = (Number Mod 30323)
            ' lngX, lngY and lngZ must be bigger than 0
            If lngX > 0 Then Else lngX = 171
            If lngY > 0 Then Else lngY = 172
            If lngZ > 0 Then Else lngZ = 170
            ' mark initialization state
            blnInit = True
        End If
        ' generate a random number
        dblRnd = CDbl(lngX) / 30269# + CDbl(lngY) / 30307# + CDbl(lngZ) / 30323#
        ' return a value between 0 and 1
        RndM = dblRnd - Int(dblRnd)
    End Function
    Here are a few pointers:
    • True conditions are faster than False conditions -> set code that is ran more often behind True condition.
    • I minimized the amount of calculation when checking for initialized values. By using a local static variable we know that X, Y and Z are valid.
    • I decided to use 0 as number to cause Timer to be used automatically for seeding: if someone wants repeatable random numbers, he knows to give a seed.
    • ... which leads to this function having an advantage over Rnd as you don't need to call Randomize to get a different set of random numbers on each run of the application.
    • And I used variable names that tell better what datatype they represent.
    Last edited by Merri; Dec 6th, 2007 at 01:43 AM.

  3. #3

    Thread Starter
    Head Hunted anhn's Avatar
    Join Date
    Aug 2007
    Location
    Australia
    Posts
    3,669

    Re: Wichman-Hill Pseudo Random Number Generator: an alternative for VB Rnd() function

    Quote Originally Posted by Merri
    Here are a few pointers:
    • True conditions are faster than False conditions -> set code that is ran more often behind True condition.
    • I minimized the amount of calculation when checking for initialized values. By using a local static variable we know that X, Y and Z are valid.
    • I decided to use 0 as number to cause Timer to be used automatically for seeding: if someone wants repeatable random numbers, he knows to give a seed.
    • ... which leads to this function having an advantage over Rnd as you don't need to call Randomize to get a different set of random numbers on each run of the application.
    • And I used variable names that tell better what datatype they represent.
    @Merri,
    • I agree with what you mentioned. At first I wrote a single function with Static vars as you did without Randomize sub but later I changed my mind to mimic the existing pair Rnd() and Randomize() so we don't need to explain how to use it.
    • But I like your way as it look simpler. However your function won't run faster than my version, if not about 5% slower. The problem makes it run slower is Static vars (I am not sure what behind the scenes.)
    • If all vars are declared as Module Private vars instead of Function Static vars, it will boost up the speed about 20%, that means it will be faster than my version about 15%.


    Code:
    Option Explicit
    Private lngX As Long, lngY As Long, lngZ As Long, blnInit As Boolean
    Public Function RndM(Optional ByVal Number As Long) As Double
        '--Static lngX As Long, lngY As Long, lngZ As Long, blnInit As Boolean
        Dim dblRnd As Double
        ... ...

  4. #4
    Cumbrian Milk's Avatar
    Join Date
    Jan 2007
    Location
    0xDEADBEEF
    Posts
    2,448

    Re: Wichman-Hill Pseudo Random Number Generator: an alternative for VB Rnd() function

    I ran a test on both functions. I used the return value to fill a big 32Mb byte array something like this snippet...
    Code:
          i = Int(RndX * &H2000000)
          If RndResult(i) = 255 Then
             Exit For
          Else
             RndResult(i) = RndResult(i) + 1
          End If
    ...in order to count all the fractions (0/33554432, 1/33554432, 2/33554432 .... 33554431/33554432) that function would return. It stopped counting when 1 fraction was returned 255 times, it then dumped the data to a file.

    In the image below each horizontal pixel represents 32768 readings, the vertical pixels show the exact count. Around 6,000,000,000 readings were made. If the function was biased it would not show a straight line. Both functions generate nearly identical images. Very random, clear mean and variance and no obvious bias.
    Attached Images Attached Images  
    Last edited by Milk; Dec 7th, 2007 at 08:46 AM. Reason: source code added

  5. #5
    Cumbrian Milk's Avatar
    Join Date
    Jan 2007
    Location
    0xDEADBEEF
    Posts
    2,448

    Re: Wichman-Hill Pseudo Random Number Generator: an alternative for VB Rnd() function

    The same for Rnd...
    Look carefully there is an image, a line at the top and a line at the bottom. 33554432 is twice the resolution of Rnd and it's distribution is perfect (it returns exact fractions from 0/16777216 to 16777215/16777216, exactly half the data is 0 the other half is 255)
    Attached Images Attached Images  
    Attached Files Attached Files
    Last edited by Milk; Dec 7th, 2007 at 08:47 AM.

  6. #6

    Thread Starter
    Head Hunted anhn's Avatar
    Join Date
    Aug 2007
    Location
    Australia
    Posts
    3,669

    Wichmann-Hill Pseudo Random Number Generator: an alternative for VB Rnd() function

    A spectacular firework show!
    How did you come up with the test? Can you provide a full coding?
    Can you find out exactly the size of the sequence? It was said more than 10^13 but not sure what is exactly. I guess that is
    (30269-1) x (30307-1) x (30323-1) = 27,814,431,486,576 (cannot be more than this number).

    Updated:
    Yes, the cycle length is 27,814,431,486,576 ~ 2.78 x 10^13
    This is the first page of Wichmann-Hill article on this PRNG. (Feb-1982, more than 25 years ago!)

    Correction:
    Due to a spelling mistake on an MSDN page, the correct name of one of the two authors is Wichmann (not Wichman). I apology for this mistake.
    Last edited by anhn; Dec 7th, 2007 at 12:15 AM. Reason: Update.

  7. #7
    VB6, XHTML & CSS hobbyist Merri's Avatar
    Join Date
    Oct 2002
    Location
    Finland
    Posts
    6,654

    Re: Wichman-Hill Pseudo Random Number Generator: an alternative for VB Rnd() function

    Quote Originally Posted by anhn
    if not about 5% slower.
    My optimization knowledge goes for compiled code, although I know Static are slower, but I'm also a fan of good coding practises (unless I'm going for the uttermost speed one can do with VB6, and I don't see a reason to do that here).

    Anyways, without testing I guess my code's other tricks speed it up enough in comparison once compiled. There is a major difference between compiled code and P-code I guess I should test, but all my copypasteable benchmarking code is in my broken laptop's HD -> laziness.

    In the other hand, there isn't so much to optimize, you'd have to end up with simpler maths, such as taking more advantage of the 31 bits that are available in a Long. Then find two higher prime numbers to use (because the numbers being used a prime numbers) and use those instead of using three. Less math results in more speed, but may drop the randomness level.


    More edit:
    &H7FFFFFFF / 171 = 12558383,900584795321637426900585
    &H7FFFFFFF / 170 = 12632256,747058823529411764705882

    Find two prime numbers that are closest below of those two values and you should have something to test
    Last edited by Merri; Dec 7th, 2007 at 08:11 AM.

  8. #8
    VB6, XHTML & CSS hobbyist Merri's Avatar
    Join Date
    Oct 2002
    Location
    Finland
    Posts
    6,654

    Re: Wichmann-Hill Pseudo Random Number Generator: an alternative for VB Rnd() function

    Milk has something more to test:
    Code:
    Public Function RndM(Optional ByVal Number As Long) As Double
        Static lngX As Long, lngY As Long, lngZ As Long, blnInit As Boolean
        Dim dblRnd As Double
        ' if initialized and no input number given
        If blnInit And Number = 0 Then
            ' lngX, lngY and lngZ will never be 0
            lngX = (170 * lngX) Mod 12632251
            lngY = (171 * lngY) Mod 12558383
            'lngX = (171 * lngX) Mod 30269
            'lngY = (172 * lngY) Mod 30307
            'lngZ = (170 * lngZ) Mod 30323
        Else
            ' if no initialization, use Timer, otherwise ensure positive Number
            If Number = 0 Then Number = Timer * 60 Else Number = Number And &H7FFFFFFF
            lngX = (Number Mod 12632251)
            lngY = (Number Mod 12558383)
            'lngX = (Number Mod 30269)
            'lngY = (Number Mod 30307)
            'lngZ = (Number Mod 30323)
            ' lngX, lngY and lngZ must be bigger than 0
            If lngX > 0 Then Else lngX = 170
            If lngY > 0 Then Else lngY = 171
            'If lngX > 0 Then Else lngX = 171
            'If lngY > 0 Then Else lngY = 172
            'If lngZ > 0 Then Else lngZ = 170
            ' mark initialization state
            blnInit = True
        End If
        ' generate a random number
        dblRnd = CDbl(lngX) / 12632251# + CDbl(lngY) / 12558383# '+ CDbl(lngZ) / 30323#
        'dblRnd = CDbl(lngX) / 30269# + CDbl(lngY) / 30307# + CDbl(lngZ) / 30323#
        ' return a value between 0 and 1
        RndM = dblRnd - Int(dblRnd)
    End Function
    Less math, but will it work? It runs on my assumption that a prime number is the important factor.

  9. #9
    Cumbrian Milk's Avatar
    Join Date
    Jan 2007
    Location
    0xDEADBEEF
    Posts
    2,448

    Re: Wichmann-Hill Pseudo Random Number Generator: an alternative for VB Rnd() functio

    hmm, this sounds like it it might be a job for this. I think it will wipeout Rnd, but I think losing the third value might be a great loss in terms of the randomness.... that being kind of relative depending if you are interested in atomic decay or rolling a dice.

    I'll give it a test over the WE. What I've done measures the frequency of fractions over a reasonably large resolution. The data I've gathered is not yet fully analysed, and is fairly limited as order of readings is not taken into account.

    The old Rnd has 16'777'216 combinations. The Wichmann Hill can give you 27'814'431'486'576. The new two Long algorithm has a possible 158'640'621'019'500 return values.

    To put things in perspective, there are 80'658'175'170'943'878'571'660'636'856'403'766'975'289'505'440'883'277'824'000'000'000'000 (68 digits) possible combinations for a deck of cards.
    Last edited by Milk; Dec 8th, 2007 at 04:13 AM. Reason: can't times

  10. #10

    Thread Starter
    Head Hunted anhn's Avatar
    Join Date
    Aug 2007
    Location
    Australia
    Posts
    3,669

    Re: Wichmann-Hill Pseudo Random Number Generator: an alternative for VB Rnd() function

    Merry & Milk,
    We may have gone too far.
    Actually, 171, 172 and 170 have some relations to 30269, 30307 and 30323.
    They have been chosen to ensure that for each individual x,y,z can return full cycle.

  11. #11
    VB6, XHTML & CSS hobbyist Merri's Avatar
    Join Date
    Oct 2002
    Location
    Finland
    Posts
    6,654

    Re: Wichmann-Hill Pseudo Random Number Generator: an alternative for VB Rnd() function

    Are you able to go further into detail on why those are exactly the numbers that work? Also, how could I figure it out without doing a brute-force test? A quick google didn't help me very much and the article you linked to apparently wants me to pay to see it all.

    I'm not very good with theoretical math though, this is why I just did what I did.

  12. #12

    Thread Starter
    Head Hunted anhn's Avatar
    Join Date
    Aug 2007
    Location
    Australia
    Posts
    3,669

    Re: Wichmann-Hill Pseudo Random Number Generator: an alternative for VB Rnd() functio

    I don't want to go with too much details on how those numbers worked, as we need to learn much more theory on statistic and randomness. I did one year on statistics 33 years ago and was a top student in this course but there is nothing left in my head now. I don't want to build another algorithm and prove it works, that is too far over my ability now (may be because I am too old, not smart enough and lazy to think).

    I have seen many algorithms on PRNG but perhaps Wichmann-Hill's one is quite simple and machine independent, easy to write in any language. (I also found another version of this algorithm for 16-bit machine, but we don't need to discuss it now).

    It does not mean we will use whatever Microsoft uses, but there are many articles that complained about the RAND() function in Excel prior to version 2003 so Microsoft decided to use Wichmann-Hill's algorithm to rewrite the RAND() function. The first version of WH RAND() function in Excel 2003 contains a terrible error likes a joke: it can return a negative number, when reported Microsoft had to release a patch to fix it.

    Of course there is no perfect PRNG that is why they are called pseudo. WH's algorithm is now more than 25-year-old (Feb-1982), perhaps no one has found any flaw in it, many people have implemented it in many different languages but I haven't seen it in VB (or I could not find it). During the last 2 months I saw at least 2 people in this forum need to have a random function that is better than VB build-in Rnd() function, so I just try to do it in VB with WH's algorithm after I read a KB in MSDN.

    As what I understand, all ix, iy and iz are 3 random numbers in a much smaller ranges, however when they are combined as what W&H did they can give a new random number in a much larger range.

    As you already knew all 3 numbers 30269, 30307 and 30323 are prime numbers. There are other 3 primitive numbers 171, 172 and 170 that are well chosen so that the subsequence values of ix in formula
    ix = (171 * ix) mod 30269
    can cover full range from 1 to 30268, (similar for iy & iz).
    We should not waste our time to prove that again here, someone else has done that (but if you want you can do it, it's quite easy because the ranges are quite small).

    The randomness will be better if we use more numbers instead of only 3 as ix, iy and iz but W&H proved that 3 is adequate or good enough.

    Merry, you are really an expert in code optimization as si_the_geek told me.
    Milk, you have a great thought with your test that I could not imagine.

    There is one thing very interesting in W-H's article, 25 years ago they dream of generating 1000 numbers a second (it may take 880 years to cover full cycle), but now we can generate many million numbers per second with a normal desktop PC. How fast the technology has grew. It's amazing!

    PS. Sorry, I have tried to find the full WH's article that may contains 3 pages but could not find it, so in the link I said that is the first page of the article.
    Last edited by anhn; Dec 8th, 2007 at 07:18 AM.

  13. #13

    Thread Starter
    Head Hunted anhn's Avatar
    Join Date
    Aug 2007
    Location
    Australia
    Posts
    3,669

    Re: Wichmann-Hill Pseudo Random Number Generator: an alternative for VB Rnd() function

    You should read this: http://www.15seconds.com/issue/051110.htm
    After that you may not want to use the pair Rnd() and Randomize() any more in VB, VBA or VB.NET. People may want to use my function (or Merry's version) in their critical projects.

    Additional reading:
    http://support.microsoft.com/default...b;en-us;120587
    http://msdn.microsoft.com/library/de...mrandomize.asp

  14. #14
    Frenzied Member zaza's Avatar
    Join Date
    Apr 2001
    Location
    Borneo Rainforest Habits: Scratching
    Posts
    1,486

    Re: Wichmann-Hill Pseudo Random Number Generator: an alternative for VB Rnd() function

    Also see the Gaussian Random Number generator links in my sig. There is a uniform pseudo-random number generator in there, using a L'Ecuyer generator with a Bays-Durham shuffle.
    I use VB 6, VB.Net 2003 and Office 2010



    Code:
    Excel Graphing | Excel Timer | Excel Tips and Tricks | Add controls in Office | Data tables in Excel | Gaussian random number distribution (VB6/VBA,VB.Net) | Coordinates, Vectors and 3D volumes

  15. #15
    VB6, XHTML & CSS hobbyist Merri's Avatar
    Join Date
    Oct 2002
    Location
    Finland
    Posts
    6,654

    Re: Wichmann-Hill Pseudo Random Number Generator: an alternative for VB Rnd() functio

    I started trying out how long it'd take to go through my latter function submission to see if it repeats the first result after going around, but it looks like it'll take about 11 days to do that on my computer. Not going to happen. I've let it count 5 billion results this far and there hasn't been a repetition of the first result. Of course, that doesn't tell us if some other value has repeated at some point...

    Edit
    Or maybe I miscalculated, now got half a year estimate on recalculation. Anyways, atleast this got as far as 59 000 000 000 results without repeating the first one.
    Last edited by Merri; Dec 16th, 2007 at 04:18 AM.

  16. #16

    Thread Starter
    Head Hunted anhn's Avatar
    Join Date
    Aug 2007
    Location
    Australia
    Posts
    3,669

    Re: Wichmann-Hill Pseudo Random Number Generator: an alternative for VB Rnd() function

    I think a good PRNG is not just based on how long the cycle is (before it repeates), but the randomness is also very important. There exist some tools on the web that can be used to test a PRNG in many areas, but the way Milk used to test it is quite simple and I like it as it also gives graphical presentation as well.

  17. #17
    Cumbrian Milk's Avatar
    Join Date
    Jan 2007
    Location
    0xDEADBEEF
    Posts
    2,448

    Re: Wichmann-Hill Pseudo Random Number Generator: an alternative for VB Rnd() functio

    I would not put too much hold on my pretty pictures, good for obvious bias, not good for more subtle problems.

    The Die Hard Test is a thing to check out. I believe it's already considered a little dated but it gives a good idea. It tests 32bit integer values (signed or not does not matter) and it requires ~ a 12MB sample of values to test, floating point data won't work. I was using Int((RndX - 0.5) * 4294967296#) to convert to Long.

    Incidentally I found a couple of snippets here and there that suggest the Wichman Hill algorithm to have problems at the extremes of the distribution (by modern standards). I've also seen some implementations that use four 'primitive root modulo n' instead of three.

    Following is a list of safe primes and the first few primative roots below the primes square root. None of them will overflow.

    1660727 1288 1284 1281 1280 1278 1277 1275 1273 1271 1270
    1660559 1285 1282 1281 1279 1277 1276 1273 1270 1269 1262
    1660199 1287 1286 1279 1278 1274 1272 1269 1267 1266 1265
    1660103 1287 1285 1284 1281 1280 1277 1273 1271 1270 1269
    1660007 1287 1285 1284 1283 1280 1279 1278 1276 1274 1273
    1659683 1288 1287 1285 1283 1281 1280 1279 1276 1275 1274
    1659443 1288 1284 1283 1281 1280 1278 1276 1275 1273 1272
    1658927 1286 1285 1282 1280 1279 1278 1277 1276 1272 1271
    1658387 1287 1285 1284 1283 1280 1276 1275 1274 1272 1271
    1658243 1286 1285 1284 1280 1279 1277 1276 1275 1273 1270
    1657463 1285 1284 1283 1281 1280 1277 1275 1274 1271 1269
    1656899 1286 1285 1284 1283 1281 1279 1277 1275 1274 1272
    1656203 1285 1284 1283 1282 1281 1280 1279 1275 1274 1273
    1656119 1286 1283 1281 1276 1271 1269 1268 1267 1264 1263
    1655939 1282 1281 1277 1276 1275 1274 1272 1268 1267 1265
    1655807 1286 1285 1284 1281 1280 1279 1278 1277 1275 1273
    1655483 1285 1284 1282 1281 1280 1278 1277 1275 1273 1272
    1655279 1283 1282 1281 1276 1275 1274 1271 1270 1262 1259
    1655099 1286 1285 1284 1283 1282 1279 1276 1274 1272 1267
    1654859 1281 1278 1277 1276 1275 1272 1271 1269 1268 1267
    1654739 1286 1283 1282 1278 1276 1275 1273 1270 1267 1266
    1654427 1285 1284 1283 1280 1279 1278 1276 1271 1269 1266
    1654127 1286 1284 1282 1281 1280 1278 1275 1274 1273 1272
    1654019 1286 1285 1284 1282 1279 1276 1274 1269 1267 1265
    1653959 1286 1285 1282 1279 1276 1275 1274 1272 1270 1268
    1653767 1283 1280 1279 1276 1275 1274 1272 1271 1269 1268
    1653623 1283 1281 1280 1279 1272 1271 1270 1268 1267 1266
    1653599 1283 1282 1281 1278 1276 1273 1268 1267 1266 1264
    Last edited by Milk; Dec 16th, 2007 at 09:44 AM.

  18. #18
    VB6, XHTML & CSS hobbyist Merri's Avatar
    Join Date
    Oct 2002
    Location
    Finland
    Posts
    6,654

    Re: Wichmann-Hill Pseudo Random Number Generator: an alternative for VB Rnd() functio

    I wonder whether this provides solutions to some issues with the last version of RndM (these problems became visible in this thread).

    Code:
    Public Function RndM(Optional ByVal Number As Long) As Variant
        Static X As Long, Y As Long, Z As Long, Init As Boolean
        Dim R As Variant
        If Init And Number = 0 Then
            X = (170 * X) Mod 12632251
            Y = (171 * Y) Mod 12558383
            Z = (172 * Z) Mod 12485359
        Else
            If Number = 0 Then Number = Timer * 60 Else Number = Number And &H7FFFFFFF
            X = (Number Mod 12632251)
            Y = (Number Mod 12558383)
            Z = (Number Mod 12485359)
            If X = 0 Then X = 170
            If Y = 0 Then Y = 171
            If Z = 0 Then Z = 172
            Init = True
        End If
        R = CDec(X) / CDec(12632251) + CDec(Y) / CDec(12558383) + CDec(Z) / CDec(12485359)
        RndM = R - Int(R)
    End Function
    Instead of speed this is an attempt to provide an even larger scale. Unfortunately my theoretical math skills aren't that great so I'm not going to attempt to figure out how big the maximum set of numbers is.

  19. #19

    Thread Starter
    Head Hunted anhn's Avatar
    Join Date
    Aug 2007
    Location
    Australia
    Posts
    3,669

    Re: Wichmann-Hill Pseudo Random Number Generator: an alternative for VB Rnd() functio

    For people other than Merri: This discussion related to post#23 in this thread
    @Merri,
    Some things need to be proved first:
    Code:
    X = (170 * X) Mod 12632251 '-- must cover full range from 1 to 12632250
    Y = (171 * Y) Mod 12558383 '-- must cover full range from 1 to 12558382
    Z = (172 * Z) Mod 12485359 '-- must cover full range from 1 to 12485358
    If you can prove that then the size of the set of numbers returned will be equal to:
    12632250 * 12558382 * 12485358 = 1,980,684,946,770,782,481,000
    that is still well under 9012 = 282,429,536,481,000,000,000,000 of the other thread.

    So you need to choose 3 other larger prime numbers with a proof as mentioned above.

    Secondly, instead of return Scale-28 Decimal numbers (with up to 28 decimal places), we should switch to Scale-0 Decimal numbers (no decimal place) by changing the return formula of R:
    Code:
    from:
       R1 = CDec(X) / CDec(12632251) + CDec(Y) / CDec(12558383) + CDec(Z) / CDec(12485359)
    
    to:
       R2 = CDec(x) * CDec(12558383) * CDec(12485359) + _
            CDec(Y) * CDec(12485359) * CDec(12632251) + _
            CDec(Z) * CDec(12632251) * CDec(12558383)
    
    you may see that:
       R2 = R1 * (CDec(12558383) * CDec(12485359) * CDec(12632251))
    For not confusing, rename the function to something like LargeRndInt()
    • Don't forget to use [CODE]your code here[/CODE] when posting code
    • If your question was answered please use Thread Tools to mark your thread [RESOLVED]
    • Don't forget to RATE helpful posts

    • Baby Steps a guided tour
    • IsDigits() and IsNumber() functions • Wichmann-Hill Random() function • >> and << functions for VB • CopyFileByChunk

  20. #20
    VB6, XHTML & CSS hobbyist Merri's Avatar
    Join Date
    Oct 2002
    Location
    Finland
    Posts
    6,654

    Re: Wichmann-Hill Pseudo Random Number Generator: an alternative for VB Rnd() functio

    I made some searching and found out people prefer Mersenne twister these days. There is a VB6 implementation over at Planet Source Code, the problem being it is not a short code and it isn't optimized in any way. Doesn't interest me enough to go ahead and work around the issues... I guess the unsigned 32-bit processing should be dropped to 31-bit so that it works with Long –&#160;but I don't know how much this would change the algorithm. Would require reading & studying to get it right.


    Update!
    There is also an implementation in REALbasic. Being a relatively short code it could be used as a model for VB6 version.

  21. #21
    New Member
    Join Date
    Nov 2010
    Posts
    14

    Resolved Re: Wichmann-Hill Pseudo Random Number Generator: an alternative for VB Rnd() functio

    Excuse Me! Why More and More Lines of Codes?

    Just use this to Generate Random Numbers

    Code:
    Public Function GenerateCode(iLen As Integer) As String
    On Error Resume Next
       strInputString = "0123456789"
       intLength = Len(strInputString)
       intNameLength = iLen
       Randomize
       strName = ""
       For intStep = 1 To intNameLength
           intRnd = Int((intLength * Rnd) + 1)
           strName = strName & Mid(strInputString, intRnd, 1)
       Next
       GenerateCode = strName
    End Function
    Mo!eN User Banned =))
    Thanks
    I Love My New 1Chr Username =))

  22. #22
    Lively Member
    Join Date
    Sep 2006
    Posts
    96

    Re: Wichman-Hill Pseudo Random Number Generator: an alternative for VB Rnd() function

    Quote Originally Posted by Merri View Post
    Here is a suggestion for independent function. It doesn't work exactly the same, but I paid a lot attention to details on how it works.

    Code:
    Public Function RndM(Optional ByVal Number As Long) As Double
        Static lngX As Long, lngY As Long, lngZ As Long, blnInit As Boolean
        Dim dblRnd As Double
        ' if initialized and no input number given
        If blnInit And Number = 0 Then
            ' lngX, lngY and lngZ will never be 0
            lngX = (171 * lngX) Mod 30269
            lngY = (172 * lngY) Mod 30307
            lngZ = (170 * lngZ) Mod 30323
        Else
            ' if no initialization, use Timer, otherwise ensure positive Number
            If Number = 0 Then Number = Timer * 60 Else Number = Number And &H7FFFFFFF
            lngX = (Number Mod 30269)
            lngY = (Number Mod 30307)
            lngZ = (Number Mod 30323)
            ' lngX, lngY and lngZ must be bigger than 0
            If lngX > 0 Then Else lngX = 171
            If lngY > 0 Then Else lngY = 172
            If lngZ > 0 Then Else lngZ = 170
            ' mark initialization state
            blnInit = True
        End If
        ' generate a random number
        dblRnd = CDbl(lngX) / 30269# + CDbl(lngY) / 30307# + CDbl(lngZ) / 30323#
        ' return a value between 0 and 1
        RndM = dblRnd - Int(dblRnd)
    End Function
    Here are a few pointers:
    • True conditions are faster than False conditions -> set code that is ran more often behind True condition.
    • I minimized the amount of calculation when checking for initialized values. By using a local static variable we know that X, Y and Z are valid.
    • I decided to use 0 as number to cause Timer to be used automatically for seeding: if someone wants repeatable random numbers, he knows to give a seed.
    • ... which leads to this function having an advantage over Rnd as you don't need to call Randomize to get a different set of random numbers on each run of the application.
    • And I used variable names that tell better what datatype they represent.
    Hi Merri, Not sure of the code rules here but is it ok if I use this code in my project?

  23. #23
    PowerPoster Nightwalker83's Avatar
    Join Date
    Dec 2001
    Location
    Adelaide, Australia
    Posts
    13,344

    Re: Wichman-Hill Pseudo Random Number Generator: an alternative for VB Rnd() function

    Quote Originally Posted by fruitman View Post
    Hi Merri, Not sure of the code rules here but is it ok if I use this code in my project?
    I think it is fine to use other people code in your project as long as you include credit to the appropriate people/group of in your application.
    when you quote a post could you please do it via the "Reply With Quote" button or if it multiple post click the "''+" button then "Reply With Quote" button.
    If this thread is finished with please mark it "Resolved" by selecting "Mark thread resolved" from the "Thread tools" drop-down menu.
    https://get.cryptobrowser.site/30/4111672

  24. #24
    New Member
    Join Date
    Dec 2017
    Posts
    2

    Re: Wichman-Hill Pseudo Random Number Generator: an alternative for VB Rnd() function

    Dear Mr. Piittinen,

    I am using your algorithm "rndM" (Wichmann-Hall random number generator) [1] for educational purposes and would like to include it in a book, if you don't object.

    I have written a book (in German): "Physics with Excel and visual basic" [2] and I am preparing a second book (also in German) "Learning and understanding Physics with Excel and visual basic", where I treat topics in Theoretical Physics taught in the first two years of a Physics course at universities. In the chapter "Stochastic movements" I realized the limits of the VBA function RND. The entropy in a simulated diffusion process began to decrease after some diffusion time while your algorithm yielded reasonable results.

    In the first book, I discovered also an error in the LOGEST spreadsheet function. The uncertainties of the regression coefficients were wrong but could be corrected with simple operations. I found nowhere in Microsoft to report this.

    With kind regards
    Dieter Mergel

    [1] http://www.vbforums.com/showthread.p...Rnd()-function, by user Merri Dec 6th, 2007, 12:29 AM (Vesa Piittinen)
    [2] http://www.springer.com/de/book/9783642378560

  25. #25
    New Member
    Join Date
    Dec 2017
    Posts
    2

    Re: Wichman-Hill Pseudo Random Number Generator: an alternative for VB Rnd() function

    Dear Mr. Piittinen,

    I am using your algorithm "rndM" (Wichmann-Hall random number generator) [1] for educational purposes and would like to include it in a book, if you don't object.

    I have written a book (in German): "Physics with Excel and visual basic" [2] and I am preparing a second book (also in German) "Learning and understanding Physics with Excel and visual basic", where I treat topics in Theoretical Physics taught in the first two years of a Physics course at universities. In the chapter "Stochastic movements" I realized the limits of the vba function RND. The entropy in a simulated diffusion process started to decrease after some diffusion time while your algorithm yielded reasonable results.

    In the first book, I discovered also an error in the LOGEST spreadsheet function. The uncertainties of the regression coefficients were wrong but could be corrected with simple operations. I found nowhere in Microsoft to report this.

    With kind regards
    Dieter Mergel

    [1] http://www.vbforums.com/showthread.p...Rnd()-function, by user Merri Dec 6th, 2007, 12:29 AM (Vesa Piittinen)
    [2] http://www.springer.com/de/book/9783642378560


    Quote Originally Posted by Merri View Post
    Here is a suggestion for independent function. It doesn't work exactly the same, but I paid a lot attention to details on how it works.

    Code:
    Public Function RndM(Optional ByVal Number As Long) As Double
        Static lngX As Long, lngY As Long, lngZ As Long, blnInit As Boolean
        Dim dblRnd As Double
        ' if initialized and no input number given
        If blnInit And Number = 0 Then
            ' lngX, lngY and lngZ will never be 0
            lngX = (171 * lngX) Mod 30269
            lngY = (172 * lngY) Mod 30307
            lngZ = (170 * lngZ) Mod 30323
        Else
            ' if no initialization, use Timer, otherwise ensure positive Number
            If Number = 0 Then Number = Timer * 60 Else Number = Number And &H7FFFFFFF
            lngX = (Number Mod 30269)
            lngY = (Number Mod 30307)
            lngZ = (Number Mod 30323)
            ' lngX, lngY and lngZ must be bigger than 0
            If lngX > 0 Then Else lngX = 171
            If lngY > 0 Then Else lngY = 172
            If lngZ > 0 Then Else lngZ = 170
            ' mark initialization state
            blnInit = True
        End If
        ' generate a random number
        dblRnd = CDbl(lngX) / 30269# + CDbl(lngY) / 30307# + CDbl(lngZ) / 30323#
        ' return a value between 0 and 1
        RndM = dblRnd - Int(dblRnd)
    End Function
    Here are a few pointers:
    • True conditions are faster than False conditions -> set code that is ran more often behind True condition.
    • I minimized the amount of calculation when checking for initialized values. By using a local static variable we know that X, Y and Z are valid.
    • I decided to use 0 as number to cause Timer to be used automatically for seeding: if someone wants repeatable random numbers, he knows to give a seed.
    • ... which leads to this function having an advantage over Rnd as you don't need to call Randomize to get a different set of random numbers on each run of the application.
    • And I used variable names that tell better what datatype they represent.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width