Генератор випадкових чисел Mathematica відхиляється від ймовірності бінома?

Отже, скажімо, ви переверніть монету 10 разів і назвіть цю 1 "подію". Якщо ви запускаєте 1000000 цих "подій", яка частка подій, у яких голова між 0,4 і 0,6? Біноміальна ймовірність підказує, що це приблизно 0,65, але мій код Mathematica говорить мені про 0,24

Ось мій синтаксис:

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

Де невдача?

Неправильне використання - це використання суворого менше.

За допомогою десяти закидів єдиний спосіб отримати результат пропорції головок строго між 0,4 і 0,6 - якщо ви отримаєте рівно 5 голів. Це вірогідність приблизно 0,246 ( ), що стосується того, що ваші моделювання (правильно ) давати.${{_{10}}\choose{^5}}(\frac{_1}{^2})^{10}\approx 0.246$

Якщо ви включите 0,4 і 0,6 у свої межі (тобто 4, 5 або 6 голів у 10 закидів), результат має ймовірність приблизно 0,656, стільки, як ви очікували.

Ваша перша думка не повинна бути проблемою з генератором випадкових чисел. Така проблема була б очевидною в такому широко використовуваному пакеті, як Mathematica.

Деякі коментарі до написаного вами коду:

• Ви визначили, experiment[n_]але ніколи не використовували його, замість цього повторили його визначення в trialheadcount[n_].
• experiment[n_]може бути набагато ефективніше запрограмоване (без використання вбудованої команди BinomialDistribution), оскільки Total[RandomInteger[{0,1},n]/nце також зробить Xнепотрібним.
• Підрахунок кількості випадків, коли experiment[n_]строго між 0,4 і 0,6, ефективніше виконується шляхом написання Length[Select[Table[experiment[10],{10^6}], 0.4 < # < 0.6 &]].

Але для власне питання, як вказує Glen_b, біноміальний розподіл дискретний. З 10 кидків монети з спостерігала голови, ймовірність того, що зразок частка головок є строго між 0,4 і 0,6 насправді просто випадок ; тобто Тоді якби ви обчислили ймовірність того, що частка вибірки становить від 0,4 до 0,6 включно , це буде Тому вам потрібно лише змінити код для використання$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.6замість цього. Але ми, звичайно, також могли написати

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

Ця команда приблизно в 9,6 разів швидша, ніж ваш вихідний код. Я думаю, що хтось навіть більш досвідчений, ніж я в Mathematica, міг би прискорити це ще більше.

Проведення ймовірнісних експериментів у Mathematica

Mathematica пропонує дуже зручні рамки для роботи з ймовірностями та розподілами, і - хоча головне питання відповідних лімітів було вирішено - я хотів би використати це питання, щоб зробити це більш зрозумілим і, можливо, корисним як орієнтир.

Давайте просто зробимо експерименти повторювані та визначимо кілька варіантів сюжету, щоб вони відповідали нашому смаку:

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

Робота з параметричними розподілами

Тепер ми можемо визначити асимптотичний розподіл для однієї події, яка є пропорцією голів у кидках (справедливої) монети:$\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
        ]
    }
]

Що дає нам графік дискретного розподілу пропорцій:

Ми можемо використати розподіл негайно для обчислення ймовірностей для і :$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}

Робити експерименти в Монте-Карло

Ми можемо використовувати розподіл для однієї події для багаторазової вибірки з нього (Монте-Карло).

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
    ]
]

Порівнюючи це з теоретичним / асимптотичним розподілом, видно, що все, що дуже сильно вписується в:

Show @ {
   theoreticalPlot,
   empiricalPlot
}