Monte-Carlo-Simulation zum Werfen einer Münze, um ein bestimmtes Muster zu erhalten

Question

Inspiriert von diesem Artikel: Statistics of Coin-Toss Patterns, habe ich eine Monte-Carlo-Simulation durchgeführt, um die erwartete Anzahl von Münzen zu erhalten, um ein bestimmtes Muster mit Excel VBA zu erhalten. Der folgende Code ist die Monte-Carlo-Simulation zum Werfen einer fairen Münze, um Muster HTH zu erhalten, wobei H Kopf (1) und T Schwanz (0) ist.

, die mit dem Ergebnis übereinstimmt, wie in dem Artikel gezeigt:

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 

Die Ausgabe des Programms wird, wie unten gezeigt. Andere Muster zum Werfen einer fairen Münze sind ebenfalls passend. Trotz der Ergebnisse bin ich immer noch unsicher, ob das Programm, das ich geschrieben habe, korrekt ist oder nicht. Meine Zweifel entstehen, wenn die Münze unfair ist, dh p1, p2 und p3 sind nicht gleich 0,5, da ich keine Informationen habe, um ihre Genauigkeit zu überprüfen. Ich möchte auch wissen, wie man ein effizientes Programm in VBA Excel oder R schreibt, um die obige Simulation für ein längeres Muster wie THTHTHTHTH, THTTHHTHTTH usw. auszuführen, und seine Schleifen sind mehr als 1.000.000 (vielleicht 100.000.000 oder 1.000.000.000), aber immer noch ziemlich schnell? Irgendeine Idee?

Answer 1

Um es effizienter zu machen, könnten Sie die Bits einer Variablen verwenden, indem Sie ein Bit mit einem Toss zuweisen. Dann gilt für jede werfen, drehen die Bits auf der linken Seite und den Münzwurf Ergebnis in der ersten Position hinzufügen, bis die Bits auf der rechten Seite eine Übereinstimmung mit dem Muster sind:

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 

Beachten Sie, dass VBA nicht über eine Bit-Verschiebung Operator, aber 1 Bit links Verschiebung ist die gleiche wie durch 2 multipliziert:

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

Hier ein Beispiel ist die durchschnittliche Anzahl der Münzwurf zu bekommen um eine Sequenz zu entsprechen:

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

Sie benötigen eine Zeichenfolge zum Speichern von Mustern, die Sie suchen möchten.

Anschließend nach jedem Wurf das letzte Ergebnis am Ende der Ergebniszeichenfolge anhängen.

Überprüfen Sie dann, ob die letzten n Ziffern der Ergebniszeichenfolge == Muster, wobei n = Länge des Musters.

Wenn Match dann Rekordzahlen von Würfen und leere Ergebnisse String und gehen wieder ...

Sie konnte es wahrscheinlich von Code in etwa 20 Zeilen! Ich hoffe, das hilft.