Предвзято ли VBA PRNG?

Question

При имитации бросков костей с помощью функции Rnd я заметил, что некоторые результаты были более частыми, чем предполагалось.

Пример кода:

' Note, depending on computer speed this procedure may take about a minute to run
Sub sim3()

    Dim intFirst As Integer, intSecond As Integer, intDie1 As Integer, intDie2 As Integer
    Dim i As Long, j As Long, lngCount As Long, lngExpected As Long, lngLowerCount As Long, lngIterations As Long

    lngIterations = 1000000

    ' select dice roll
    intDie1 = 1 ' any number between 1 and 6
    intDie2 = 3 ' any number between 1 and 6
        
    ' expected frequency 
    ' (= 55,555 if lngIterations = 1,000,000 and intDie1 <> intDie2, = 27777 if lngIterations = 1,000,000 and intDie1 = intDie2)
    If intDie1 = intDie2 Then lngExpected = Int((1 / 36) * CDbl(lngIterations)) Else _
        lngExpected = Int((2 / 36) * CDbl(lngIterations)) 

    For i = 1 To 100
        
        lngCount = 0
        
        For j = 1 To lngIterations
            
            If j Mod 10000 = 0 Then DoEvents ' outcomment for faster execution
            
            intFirst = randomDie
            intSecond = randomDie
            
            ' count occurences of specific outcomes
            If intFirst = intDie1 And intSecond = intDie2 Then ' 1,4
                lngCount = lngCount + 1
            ElseIf intFirst = intDie2 And intSecond = intDie1 Then ' 4, 1
                lngCount = lngCount + 1
            End If
                        
        Next j
        
        If lngCount < lngExpected Then lngLowerCount = lngLowerCount + 1
        
        Debug.Print i & ": #favourable outcomes: " & lngCount ' outcomment for faster execution
        
    Next i
    
    Debug.Print "(" & intDie1 & "," & intDie2 & ") #expected favourable outcomes per iteration (int.): " & lngExpected
    Debug.Print "(" & intDie1 & "," & intDie2 & ") #iterations with lower than expected number of favourable outcomes: " & lngLowerCount
    Debug.Print "(" & intDie1 & "," & intDie2 & ") Prob. of obtaining result or lower, F(x|n,p) : " & WorksheetFunction.Binom_Dist(lngLowerCount, i, 0.5, True)
    
End Sub

The randomDie функция, используемая в процедуре, представляет собой стандартный код для генерации целого числа от 1 до 6 ( источник ):

Function randomDie() As Integer
    Randomize
    randomDie = Int((6 * Rnd) + 1)
End Function

Обратите внимание на оператор Randomize, который сдвигает начальное число PRNG VBA алгоритм каждый раз, когда функция вызывается, что означает, что результаты процедуры sim3 будут не одинаковыми каждый раз, когда она выполняется.

Результаты для 21 комбинации кубиков бросаются вместе с вероятность получения этого или более низкого результата:

введите описание изображения здесь

Мы ожидаем, что результаты благоприятных исходов будут примерно равномерно распределены вокруг среднего (μ = 50, i=100), но эти результаты абсолютно экстремальные .

Есть ли в моем коде fl aws, проблема в моем компьютере или VBA PRNG смещен?

Answer 1

Делайте не звоните Randomize каждый раз, когда вам нужен случайный номер. Вот где ошибка.

Randomize использует системный таймер с разрешением 50 миллисекунд для изменения начального числа. Вызовите его дважды в течение этого временного окна, и это приведет к в той же последовательности случайных чисел .

Так что просто запустите свой код с вызовами Rnd несколько раз, а Randomize только один раз ( если есть).

Function randomDie() As Long
    randomDie = CLng((6 * Rnd) + 1)
End Function

PS. Избегайте использования Integer в VBA, поскольку это 16-битное число, которое может легко переполниться. Вместо этого везде используйте Long, что является хорошим родным 32-битным целым числом.

Answer 2

Вы можете оставить псевдослучайный метод и go для действительно случайных чисел, как описано в моем проекте VBA.Random .

Он поставляется с традиционный бросать кости демо:

' Simulate trows of dice, and return and list the result.
' Calculates and prints the average pip value and its
' offset from the ideal average.
'
' Example:
'   ThrowDice 10, 7
'
'               Die 1         Die 2         Die 3         Die 4         Die 5         Die 6         Die 7         Die 8         Die 9         Die 10
' Throw 1          3             6             3             2             4             1             5             3             3             2
' Throw 2          1             3             1             6             5             1             1             3             2             2
' Throw 3          4             1             1             5             5             3             2             1             4             4
' Throw 4          3             3             6             6             5             3             1             4             6             4
' Throw 5          5             1             6             6             2             6             6             2             4             6
' Throw 6          6             3             1             5             6             4             2             5             6             5
' Throw 7          4             2             5             3             3             1             6             3             2             1
'
' Average pips: 3.50          0,00% off
'
' Note: Even though this example _is_ real, don't expect the average pips to be exactly 3.50.
'
' 2019-12-26. Gustav Brock, Cactus Data ApS, CPH.
'
Public Function ThrowDice( _
    Optional Throws As Integer = 1, _
    Optional Dice As Integer = 1) _
    As Integer()
    
    ' Array dimensions.
    Const DieDimension      As Long = 1
    Const ThrowDimension    As Long = 2
    
    ' Pip values.
    Const MaximumPip        As Double = 6
    Const MinimumPip        As Double = 1
    ' The average pip equals the median pip.
    Const AveragePip        As Double = (MinimumPip + MaximumPip) / 2
    Const NeutralPip        As Double = 0
    
    Dim DiceTrows()         As Integer
    Dim Die                 As Integer
    Dim Throw               As Integer
    Dim Size                As Long
    Dim Total               As Double
    
    If Dice <= 0 Or Throws <= 0 Then
        ' Return one throw of one die with unknown (neutral) result.
        Throws = 1
        Dice = 1
        Size = 0
    Else
        ' Prepare retrieval of values.
        Size = Throws * Dice
        QrnIntegerSize Size
        QrnIntegerMaximum MaximumPip
        QrnIntegerMinimum MinimumPip
    End If
    
    ReDim DiceTrows(1 To Dice, 1 To Throws)

    If Size > 0 Then
        ' Fill array with results.
        For Throw = LBound(DiceTrows, ThrowDimension) To UBound(DiceTrows, ThrowDimension)
            For Die = LBound(DiceTrows, DieDimension) To UBound(DiceTrows, DieDimension)
                DiceTrows(Die, Throw) = QrnInteger
                Total = Total + DiceTrows(Die, Throw)
            Next
        Next
    End If
    
    ' Print header line.
    Debug.Print , ;
    For Die = LBound(DiceTrows, DieDimension) To UBound(DiceTrows, DieDimension)
        Debug.Print "Die" & Str(Die), ;
    Next
    Debug.Print
    
    ' Print results.
    For Throw = LBound(DiceTrows, ThrowDimension) To UBound(DiceTrows, ThrowDimension)
        Debug.Print "Throw" & Str(Throw);
        For Die = LBound(DiceTrows, DieDimension) To UBound(DiceTrows, DieDimension)
            Debug.Print , "   " & DiceTrows(Die, Throw);
        Next
        Debug.Print
    Next
    Debug.Print
    
    ' Print total.
    If DiceTrows(1, 1) = NeutralPip Then
        ' No total to print.
    Else
        Debug.Print "Average pips:", Format(Total / Size, "0.00"), Format((Total / Size - AveragePip) / AveragePip, "Percent") & " off"
        Debug.Print
    End If
    
    ThrowDice = DiceTrows

End Function