Generator angka acak Matematika menyimpang dari probabilitas binomial?

Jadi, katakanlah Anda melempar koin 10 kali, dan menyebutnya 1 "peristiwa". Jika Anda menjalankan, 1.000.000 "acara" ini, berapa proporsi acara yang memiliki kepala antara 0,4 dan 0,6? Probabilitas binomial menyarankan ini sekitar 0,65, tetapi kode Mathematica saya memberi tahu saya sekitar 0,24

Inilah sintaksis saya:

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

Di mana kecelakaan itu?

Kecelakaan adalah penggunaan kurang dari ketat.

Dengan sepuluh kali lemparan, satu-satunya cara untuk mendapatkan hasil proporsi kepala ketat antara 0,4 dan 0,6 adalah jika Anda mendapatkan tepat 5 kepala. Itu memiliki probabilitas sekitar 0,246 ( ), yaitu tentang apa yang diberikan oleh simulasi Anda (dengan benar).${{_{10}}\choose{^5}}(\frac{_1}{^2})^{10}\approx 0.246$

Jika Anda memasukkan 0,4 dan 0,6 dalam batas Anda, (yaitu 4, 5 atau 6 head dalam 10 kali lemparan) hasilnya memiliki probabilitas sekitar 0,656, seperti yang Anda harapkan.

Pikiran pertama Anda seharusnya tidak menjadi masalah dengan generator angka acak. Masalah seperti itu sudah jelas dalam paket yang banyak digunakan seperti Mathematica jauh sebelum sekarang.

Beberapa komentar tentang kode yang Anda tulis:

• Anda mendefinisikan experiment[n_]tetapi tidak pernah menggunakannya, alih-alih mengulangi definisinya di trialheadcount[n_].
• experiment[n_]dapat diprogram secara lebih efisien (tanpa menggunakan perintah bawaan BinomialDistribution) karena Total[RandomInteger[{0,1},n]/ndan ini juga Xtidak perlu dilakukan.
• Menghitung jumlah kasus di mana experiment[n_]ketat antara 0,4 dan 0,6 lebih efisien dilakukan dengan menulis Length[Select[Table[experiment[10],{10^6}], 0.4 < # < 0.6 &]].

$x$$\hat p = x/10$$x = 5$

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

Perintah ini kira-kira 9,6 kali lebih cepat dari kode asli Anda. Saya membayangkan seseorang yang bahkan lebih mahir daripada saya di Mathematica dapat mempercepatnya lebih jauh.

Melakukan Eksperimen Probabilitas dalam Mathematica

Mathematica menawarkan kerangka kerja yang sangat nyaman untuk bekerja dengan probabilitas dan distribusi dan - sementara masalah utama batas yang sesuai telah diatasi - Saya ingin menggunakan pertanyaan ini untuk membuat ini lebih jelas dan mungkin berguna sebagai referensi.

Mari kita buat eksperimen berulang dan tentukan beberapa opsi plot agar sesuai dengan selera kita:

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

Bekerja dengan distribusi parametrik

$\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
        ]
    }
]

Yang memberi kami plot distribusi proporsi yang terpisah:

$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}

Melakukan Eksperimen Monte Carlo

Kita dapat menggunakan distribusi untuk satu acara untuk berulang kali sampel darinya (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
    ]
]

Membandingkan ini dengan distribusi teoretis / asimptotis menunjukkan bahwa segala sesuatu sangat cocok:

Show @ {
   theoreticalPlot,
   empiricalPlot
}