vbaapims-accessencryptionchipset

Can I use API or something else to get close to a TRUE RANDOM NUMBER in VBA?


Is there an API, library, or some other chip-set based command I can access in VBA?

I currently have a setup for getting random numbers; however, when I put the result sets to the test, the numbers do not even come close to generating a good statistical curve. I tested this by generating 600 simulated rolls of 2 six-sided dice totaling the 2 dice together each time. I was hoping for the number 7 to take a huge lead; however it came in second twice with nowhere near the appropriate statistical curve being created.

My current code uses the standard VBA method, but as I said fails the statistics test:

Randomize
GetRandomNo = Int((6 * RND) + 1)

Solution

  • For a rather full answer:

    There are numerous ways to generate random numbers, but one way is to use the Windows API to do the heavy lifting. Windows has API functions to generate cryptographically secure random bytes, and these functions can make use of hardware random number providers.

    First, we declare the API functions:

    Public Declare PtrSafe Function BCryptOpenAlgorithmProvider Lib "bcrypt.dll" (ByRef phAlgorithm As LongPtr, ByVal pszAlgId As LongPtr, ByVal pszImplementation As LongPtr, ByVal dwFlags As Long) As Long
    Public Declare PtrSafe Function BCryptGenRandom Lib "bcrypt.dll" (ByVal hAlgorithm As LongPtr, pbBuffer As Any, ByVal cbBuffer As Long, ByVal dwFlags As Long) As Long
    Public Declare PtrSafe Function BCryptCloseAlgorithmProvider Lib "bcrypt.dll" (ByVal hAlgorithm As LongPtr, ByVal dwFlags As Long)
    

    Then, we use this call, and use modulus to reduce our number to one in the desired range:

    Public Function RandomRangeWinApi(Lower As Long, Upper As Long) As Long
        Dim hAlg As LongPtr
        Dim iAlg As String
        iAlg = "RNG" & vbNullChar
        BCryptOpenAlgorithmProvider hAlg, StrPtr(iAlg), 0, 0
        Dim lRandom As Long
        BCryptGenRandom hAlg, lRandom, LenB(lRandom), 0
        RandomRangeWinApi = Abs(lRandom) Mod (Upper - Lower + 1) + Lower
        BCryptCloseAlgorithmProvider hAlg, 0
    End Function
    

    This approach is fine if you assume an integer has an infinite range of values. However, it hasn't, which means at the limits it's imprecise. Similarly, multiplication assumes an infinitely precise number, which also isn't true and causes a slight bias.

    We can get around this by directly using the binary presentation of numbers, and discarding numbers that fall outside of this template:

    Public Function RandomRangeExact(Lower As Long, Upper As Long) As Long
        'Initialize random number generator
        Dim hAlg As LongPtr
        Dim iAlg As String
        iAlg = "RNG" & vbNullChar
        BCryptOpenAlgorithmProvider hAlg, StrPtr(iAlg), 0, 0
        'Initialize bit template
        Dim template As Long
        Dim i As Long
        Do While template < Upper - Lower
            template = template + 2# ^ i
            i = i + 1
        Loop
        Dim lRandom As Long
        Do
            'Generate random number
            BCryptGenRandom hAlg, lRandom, LenB(lRandom), 0
            'Limit it to template
            lRandom = lRandom And template
        Loop While lRandom > (Upper - Lower) 'Regenerate if larger than desired range (should happen less than 50% of times)
        RandomRangeExact = lRandom + Lower
        BCryptCloseAlgorithmProvider hAlg, 0
    End Function
    

    Now, let's investigate the performance of your solution and both opportunities for rolling dice: I've simulated 100000 random numbers for each approach between 1 and 6.

    This is the result:

    enter image description here

    While the first approach seems to have larger variance between numbers (specifically less ones and more twos), for most applications I'd assume the first is accurate enough.