Mathematica'nın binom olasılığından sapan rasgele sayı üreteci?

Diyelim ki 10 kez bozuk para çevirdiniz ve buna 1 "etkinlik" deyin. Eğer bu "olayların" 1.000.000'ini yönetirseniz, kafaları 0.4 ile 0.6 arasında olan olayların oranı nedir? Binom olasılığı bunun yaklaşık 0,65 olmasını önerir, ancak Mathematica kodum bana yaklaşık 0,24'ü anlatıyor

İşte benim sözdizim:

In[2]:= X:= RandomInteger[];
In[3]:= experiment[n_]:= Apply[Plus, Table[X, {n}]]/n;
In[4]:= trialheadcount[n_]:= .4 < Apply[Plus, Table[X, {n}]]/n < .6
In[5]:= sample=Table[trialheadcount[10], {1000000}]
In[6]:= Count[sample2,True];
Out[6]:= 245682

Yanlışlık nerede?

Yanlışlık, daha az katı kullanmaktır.

On fırlatma ile, tam olarak 0,4 ila 0,6 arasında bir kafa oranı sonucu elde etmenin tek yolu, tam olarak 5 kafa elde etmenizdir. Bunun olasılığı yaklaşık 0.246 ( ), bu da simülasyonlarınızın ne olduğu (doğru ) vermek.${{_{10}}\choose{^5}}(\frac{_1}{^2})^{10}\approx 0.246$

Sınırlarınıza 0,4 ve 0,6 eklerseniz (yani 10 kademede 4, 5 veya 6 kafa), sonucun beklediğiniz gibi yaklaşık 0,656 olasılığı vardır.

İlk düşünceniz rastgele sayı üreteciyle ilgili bir sorun olmamalıdır. Bu tür bir problem, Mathematica gibi çok kullanılan bir pakette çok önceden belli olurdu.

Yazdığınız kod hakkında bazı yorumlar:

• Tanımladınız, experiment[n_]ancak hiç kullanmadınız, bunun yerine tanımını tekrarlayın trialheadcount[n_].
• experiment[n_](yerleşik komutu kullanmadan BinomialDistribution) çok daha verimli bir şekilde programlanabilir Total[RandomInteger[{0,1},n]/nve bu da Xgereksiz hale gelir .
• Tam olarak experiment[n_]0,4 ile 0,6 arasında olan vakaların sayılması, yazı ile daha verimli bir şekilde gerçekleştirilir Length[Select[Table[experiment[10],{10^6}], 0.4 < # < 0.6 &]].

Ancak, gerçek sorunun kendisi için, Glen_b'in belirttiği gibi, binom dağılımı ayrıktır. 10 madeni para fırlatır dışında kafaları örnek oranı ihtimalini kafaları gözlenen olduğunu kesinlikle arasında 0.4 ve 0.6 aslında sadece olduğu ; ör. Bununla birlikte, örnek oranının 0,4 ila 0,6 dahil olma olasılığını hesaplarsanız , bu Bu nedenle, kullanmak için yalnızca kodunuzu değiştirmeniz gerekir$x$$\hat p = x/10$$x = 5$

$$\Pr[X = 5] = \binom{10}{5} (0.5)^5 (1-0.5)^5 \approx 0.246094.$$ $$\Pr[4 \le X \le 6] = \sum_{x=4}^6 \binom{10}{x} (0.5)^x (1-0.5)^{10-x} = \frac{672}{1024} \approx 0.65625.$$ 0.4 <= # <= 0.6yerine. Ama tabii ki, biz de yazabiliriz

Length[Select[RandomVariate[BinomialDistribution[10,1/2],{10^6}], 4 <= # <= 6 &]]

Bu komut, orijinal kodunuzdan yaklaşık 9,6 kat daha hızlıdır. Mathematica'da olduğumdan daha yetkin birinin onu daha da hızlandırabileceğini hayal ediyorum .

Mathematica'da Olasılık Deneyleri Yapmak

Mathematica , olasılıklar ve dağılımlarla çalışmak için çok rahat bir çerçeve sunuyor ve - uygun sınırların ana konusu ele alınırken - bu soruyu daha açık ve belki de referans olarak yararlı hale getirmek için kullanmak istiyorum.

Deneyleri tekrarlanabilir hale getirelim ve zevkimize uyacak bazı çizim seçenekleri tanımlayalım:

SeedRandom["Repeatable_151115"];
$PlotTheme = "Detailed";
SetOptions[Plot, Filling -> Axis];
SetOptions[DiscretePlot, ExtentSize -> Scaled[0.5], PlotMarkers -> "Point"];

Parametrik dağılımlarla çalışma

Şimdi bir (asil) madalyonun atışlarında kafaların oranı olan bir olay için asimptotik dağılımı tanımlayabiliriz :$\pi$$n$

distProportionTenCoinThrows = With[
    {
        n = 10, (* number of coin throws *)
        p = 1/2 (* fair coin probability of head*)
    },
    (* derive the distribution for the proportion of heads *)
    TransformedDistribution[
        x/n,
        x \[Distributed] BinomialDistribution[ n, p ]
    ];

With[
    {
        pr = PlotRange -> {{0, 1}, {0, 0.25}}
    },
    theoreticalPlot = DiscretePlot[
        Evaluate @ PDF[ distProportionTenCoinThrows, p ],
        {p, 0, 1, 0.1},
        pr
    ];
    (* show plot with colored range *)
    Show @ {
        theoreticalPlot,
        DiscretePlot[
            Evaluate @ PDF[ distProportionTenCoinThrows, p ],
            {p, 0.4, 0.6, 0.1},
            pr,
            FillingStyle -> Red,
            PlotLegends -> None
        ]
    }
]

Bu bize oranların ayrık dağılımının grafiğini verir:

ve için olasılıkları hesaplamak için dağıtımı hemen kullanabiliriz. :$Pr[\,0.4 \leq \pi \leq 0.6\, |\,\pi \sim B(10,\frac{1}{2})]$$Pr[\,0.4 < \pi < 0.6\, |\,\pi \sim B(10,\frac{1}{2})]$

{
    Probability[ 0.4 <= p <= 0.6, p \[Distributed] distProportionTenCoinThrows ],
    Probability[ 0.4 < p < 0.6, p \[Distributed] distProportionTenCoinThrows ]
} // N

{0.65625, 0.246094}

Monte Carlo Deneyleri Yapmak

Bir olay için dağıtımı tekrar tekrar örneklemek için kullanabiliriz (Monte Carlo).

distProportionsOneMillionCoinThrows = With[
    {
        sampleSize = 1000000
    },
    EmpiricalDistribution[
        RandomVariate[
            distProportionTenCoinThrows,
            sampleSize
        ]
    ]
];

empiricalPlot = 
    DiscretePlot[
        Evaluate@PDF[ distProportionsOneMillionCoinThrows, p ],
        {p, 0, 1, 0.1}, 
        PlotRange -> {{0, 1}, {0, 0.25}} , 
        ExtentSize -> None, 
        PlotLegends -> None, 
        PlotStyle -> Red
    ]
]

Bunu teorik / asimptotik dağılımla karşılaştırmak, her şeyin hemen hemen aşağıdakilere uyduğunu gösterir:

Show @ {
   theoreticalPlot,
   empiricalPlot
}