Моделирование Монте-Карло для броска монеты для получения определенного рисунка

Question

Вдохновленный этой статьей: Statistics of Coin-Toss Patterns, я провел симуляцию Монте-Карло для определения ожидаемого числа бросания монеты, чтобы получить определенный шаблон с помощью Excel VBA. Следующий код - это метод Монте-Карло для подбрасывания справедливой монеты, чтобы получить шаблон HTH, где H - голова (1), а T - хвост (0).

Sub Tossing_Coin() 
    Dim Toss(1000000) As Double, NToss(1000000) As Double, AVToss(1000000) As Double 
    t0 = Timer 
    Sheet2.Cells.Clear 
    a = 0 

    For j = 1 To 1000000 

     p1 = Rnd() 
     If p1 <= 0.5 Then 
      Toss(1) = 1 
     Else 
      Toss(1) = 0 
     End If 

     p2 = Rnd() 
     If p2 <= 0.5 Then 
      Toss(2) = 1 
     Else 
      Toss(2) = 0 
     End If 

     i = 2 
     Do 
      p3 = Rnd() 
      If p3 <= 0.5 Then 
       Toss(i + 1) = 1 
      Else 
       Toss(i + 1) = 0 
      End If 

      i = i + 1 
     Loop Until Toss(i - 2) = 1 And Toss(i - 1) = 0 And Toss(i) = 1 

     NToss(j) = i 
     a = a + NToss(j) 
     AVToss(j) = a/j 
     b = AVToss(j) 
    Next j 

    MsgBox "The expected number of tossing is " & b & "." _ 
     & vbNewLine & "The running time of simulation is " & Round(Timer - t0, 2) & " s." 
End Sub 

Выход программы, как показано ниже:

что согласуется с результатом, как показано в статье. Другие образцы для подбрасывания справедливой монеты также соответствуют. Несмотря на результаты, я все еще не уверен, правильно ли написана программа, или нет. Мое сомнение возникает, когда монета несправедлива, то есть p1, p2 и p3 не равны 0.5, так как у меня нет никакой информации, чтобы проверить ее точность. Я также хочу знать, как написать эффективную программу в VBA Excel или R, чтобы выполнить симуляцию выше для более длинного шаблона, такого как THTHTHTHT, THTTHHTHTTH и т. Д., И его цикл составляет более 1 000 000 (возможно, 100 000 000 или 1 000 000 000), но все же довольно быстро? Есть идеи?

Answer 1

Чтобы сделать его более эффективным, вы можете использовать биты переменной, назначив бит с броском. Тогда для каждого перемешайте, вращать биты слева и добавить результат жеребьевки в первом положении, пока биты справа не совпадение с шаблоном:

pattern "HTH" : 101 
mask for "XXX" : 111 

1 toss "H" :  1 And 111 = 001 
2 toss "T" :  10 And 111 = 010 
3 toss "T" :  100 And 111 = 100 
4 toss "H" : 1001 And 111 = 001 
5 toss "H" : 10011 And 111 = 011 
6 toss "T" : 100110 And 111 = 110 
7 toss "H" : 1001101 And 111 = 101 : "HTH" matches the first 3 bits 

Обратите внимание, что VBA не имеет немного сдвиг оператор, но сдвиг 1 бит на левом так же, как умножение на 2:

decimal 9 = 1001 in bits 
9 + 9 = 18 = 10010 in bits 
18 + 18 = 36 = 100100 in bits 

Вот пример, чтобы получить среднее количество игр, чтобы соответствовать последовательности:

Sub UsageExample() 
    Const sequence = "HTH" 
    Const samples = 100000 

    MsgBox "Average: " & GetTossingAverage(sequence, samples) 
End Sub 

Function GetTossingAverage(sequence As String, samples As Long) As Double 
    Dim expected&, tosses&, mask&, tossCount#, i& 
    Randomize ' Initialize the random generator. ' 

    ' convert the [TH] sequence to a sequence of bits. Ex: HTH -> 00000101 ' 
    For i = 1 To Len(sequence) 
     expected = expected + expected - (Mid$(sequence, i, 1) = "T") 
    Next 

    ' generate the mask for the rotation of the bits. Ex: HTH -> 01110111 ' 
    mask = (2^(Len(sequence) * 2 + 1)) - (2^Len(sequence)) - 1 

    ' iterate the samples ' 
    For i = 1 To samples 
     tosses = mask 

     ' generate a new toss until we get the expected sequence ' 
     Do 
      tossCount = tossCount + 1 
      ' rotate the bits on the left and rand a new bit at position 1 ' 
      tosses = (tosses + tosses - (Rnd < 0.5)) And mask 
     Loop Until tosses = expected 
    Next 

    GetTossingAverage = tossCount/samples 
End Function 

Answer 2

Вам понадобится одна строка для хранения шаблона, который вы хотите найти.

Затем после каждого броска добавьте последний результат в конец строки результатов.

Затем проверьте, если последние n цифр строки результатов == pattern, где n = длина рисунка.

Если матч затем записать количество бросков и пустые строки результатов и возвратятся ...

Вы, вероятно, могли бы сделать это в течение примерно 20 строк кода! Надеюсь, это поможет.