Генератор случайных чисел Mathematica отклоняется от биномиальной вероятности?

9

Итак, допустим, вы подбрасываете монету 10 раз и называете это «событием». Если вы запустите 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

Где неудача?

Тим Макнайт
источник
3
возможно, это было бы лучше подходит для mathematica stackexchange mathematica.stackexchange.com
Jeromy Anglim
1
@JeromyAnglim В этом случае я подозреваю, что проблема, вероятно, связана с рассуждением, а не со строгим кодированием.
Glen_b
@Glen_b Я думаю, главное, что где-то в Интернете есть хороший ответ, который вы, кажется, предоставили. :-)
Jeromy Anglim

Ответы:

19

Несчастный случай - это использование строгих правил.

С десятью бросками единственный способ получить результат пропорции голов строго между 0,4 и 0,6 - это получить ровно 5 голов. Это имеет вероятность около 0,246 ( ), что соответствует вашим моделям (правильно ) дать.(105)(12)100,246

Если вы включите в свои пределы 0,4 и 0,6 (т. Е. 4, 5 или 6 голов в 10 бросках), то с вероятностью приблизительно 0,656, как вы и ожидали.

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

Glen_b - Восстановить Монику
источник
По иронии судьбы, @TimMcKnight продемонстрировал нам биномиальную вероятность.
Симон Куанг,
8

Некоторые комментарии о написанном вами коде:

  • Вы определили, 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 &]].

Иксп^знак равноИкс/10Иксзнак равно5

Pr[Иксзнак равно5]знак равно(105)(0,5)5(1-0,5)50,246094.
Pr[4Икс6]знак равноΣИксзнак равно46(10Икс)(0,5)Икс(1-0,5)10-Иксзнак равно67210240,65625.
0.4 <= # <= 0.6вместо. Но, конечно, мы могли бы также написать
Length[Select[RandomVariate[BinomialDistribution[10,1/2],{10^6}], 4 <= # <= 6 &]]

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

heropup
источник
2
Вы можете ускорить ваш код еще в 10 раз, используя Total@Map[Counts@RandomVariate[BinomialDistribution[10, 1/2], 10^6], {4, 5, 6}]. Я подозреваю Counts[], что, будучи встроенной функцией, она сильно оптимизирована по сравнению с той Select[], которая должна работать с произвольными предикатами.
Дэвид Чжан
1

Выполнение вероятностных экспериментов в Mathematica

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

Давайте просто сделаем эксперименты повторяемыми и определим некоторые параметры сюжета на наш вкус:

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

Работа с параметрическими распределениями

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

Что дает нам график дискретного распределения пропорций: TheoreticalDistributionPlot

пр[0,4π0.6|π~В(10,12)]пр[0,4<π<0.6|π~В(10,12)]

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

EmpirialDistributionPlot

Сравнение этого с теоретическим / асимптотическим распределением показывает, что все в значительной степени вписывается в:

Show @ {
   theoreticalPlot,
   empiricalPlot
}

ComparingDistributions

ГУВ
источник
Вы можете найти аналогичный пост с более подробной информацией о Mathematica на Mathematica SE .
GWR