首页
学习
活动
专区
圈层
工具
发布
社区首页 >问答首页 >是否可以在VBA中使用API或其他方法来接近真正的随机数?

是否可以在VBA中使用API或其他方法来接近真正的随机数?
EN

Stack Overflow用户
提问于 2020-04-27 10:42:55
回答 1查看 137关注 0票数 1

在VBA中是否有可以访问的API、库或其他基于芯片组的命令?

我目前有一个获取随机数的设置;但是,当我对结果集进行测试时,这些数字甚至还不能生成良好的统计曲线。我对此进行了测试,生成了600个模拟的两个六面骰子,每次两个骰子加在一起。我希望数字7能取得巨大的领先地位;然而,它两次排在第二位,与正在创建的适当统计曲线相去甚远。

我当前的代码使用标准的VBA方法,但正如我所说的,它没有通过统计测试:

代码语言:javascript
复制
Randomize
GetRandomNo = Int((6 * RND) + 1)
EN

回答 1

Stack Overflow用户

回答已采纳

发布于 2020-04-27 19:31:35

想要一个相当完整的答案:

生成随机数的方法有很多种,但其中一种方法是使用Windows API来完成繁重的工作。Windows具有生成加密安全随机字节的API函数,并且这些函数可以利用硬件随机数提供程序。

首先,我们声明API函数:

代码语言:javascript
复制
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)

然后,我们使用此调用,并使用模数将我们的数字减少到所需范围内的1:

代码语言:javascript
复制
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

如果您假设一个整数具有无限范围的值,那么这种方法是很好的。然而,它没有,这意味着在极限情况下它是不精确的。同样,乘法假设一个无限精确的数字,这也是不正确的,并导致轻微的偏差。

我们可以通过直接使用数字的二进制表示,并丢弃此模板之外的数字来解决此问题:

代码语言:javascript
复制
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

现在,让我们研究一下您的解决方案的性能和两种掷骰子的机会:我模拟了1到6之间的每种方法的100000个随机数。

这就是结果:

虽然第一种方法似乎在数字之间有更大的方差(特别是更少的1和更多的2),但对于大多数应用程序,我假设第一种方法足够准确。

票数 2
EN
页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接:

https://stackoverflow.com/questions/61450917

复制
相关文章

相似问题

领券
问题归档专栏文章快讯文章归档关键词归档开发者手册归档开发者手册 Section 归档