Le générateur de nombres aléatoires de Mathematica s'écartant de la probabilité binomiale?

Donc, disons que vous lancez une pièce 10 fois et appelez cela 1 "événement". Si vous exécutez 1 000 000 de ces "événements", quelle est la proportion d'événements dont la tête se situe entre 0,4 et 0,6? La probabilité binomiale suggérerait que cela soit d'environ 0,65, mais mon code Mathematica me dit environ 0,24

Voici ma syntaxe:

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

Où est l'incident?

L'accident est l'utilisation de strict moins de.

Avec dix lancers, le seul moyen d'obtenir un résultat en proportion de têtes strictement compris entre 0,4 et 0,6 est si vous obtenez exactement 5 têtes. Cela a une probabilité d'environ 0,246 ( ), ce qui correspond à ce que vos simulations (correctement ) donner.${{_{10}}\choose{^5}}(\frac{_1}{^2})^{10}\approx 0.246$

Si vous incluez 0,4 et 0,6 dans vos limites (c'est-à-dire 4, 5 ou 6 têtes en 10 lancers), le résultat a une probabilité d'environ 0,656, tout comme vous vous y attendiez.

Votre première pensée ne devrait pas être un problème avec le générateur de nombres aléatoires. Ce genre de problème aurait été évident dans un paquet très utilisé comme Mathematica bien avant maintenant.

Quelques commentaires sur le code que vous avez écrit:

• Vous l'avez défini experiment[n_]mais ne l' avez jamais utilisé, au lieu de répéter sa définition dans trialheadcount[n_].
• experiment[n_]pourrait être programmé beaucoup plus efficacement (sans utiliser la commande intégrée BinomialDistribution) car Total[RandomInteger[{0,1},n]/ncela rendrait également Xinutile.
• Le comptage du nombre de cas où experiment[n_]est strictement compris entre 0,4 et 0,6 est plus efficacement réalisé en écrivant Length[Select[Table[experiment[10],{10^6}], 0.4 < # < 0.6 &]].

Mais, pour la question elle-même, comme le souligne Glen_b, la distribution binomiale est discrète. Sur 10 lancers de pièces avec têtes observées, la probabilité que la proportion d'échantillon de têtes soit strictement comprise entre 0,4 et 0,6 est en fait juste le cas ; c'est-à-dire, Alors que si vous calculez la probabilité que la proportion d'échantillon soit comprise entre 0,4 et 0,6 inclus , ce serait Par conséquent, il vous suffit de modifier votre code pour utiliser$x$$\hat p = x/10$$x = 5$Pr[4≤X≤6]=6 ∑ x=4 (

$$\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.6au lieu. Mais bien sûr, on pourrait aussi écrire

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

Cette commande est environ 9,6 fois plus rapide que votre code d'origine. J'imagine que quelqu'un encore plus compétent que moi à Mathematica pourrait accélérer encore plus.

Faire des expériences de probabilité dans Mathematica

Mathematica offre un cadre très confortable pour travailler avec les probabilités et les distributions et - bien que le problème principal des limites appropriées ait été résolu - je voudrais utiliser cette question pour le rendre plus clair et peut-être utile comme référence.

Rendons simplement les expériences reproductibles et définissons quelques options de complot à notre goût:

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

Travailler avec des distributions paramétriques

Nous pouvons maintenant définir la distribution asymptotique pour un événement qui est la proportion de têtes en lancers d'une pièce (juste):$\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
        ]
    }
]

Ce qui nous donne l'intrigue de la distribution discrète des proportions:

Nous pouvons utiliser la distribution immédiatement pour calculer les probabilités pour et :Pr$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}

Faire des expériences de Monte Carlo

Nous pouvons utiliser la distribution d'un événement pour en échantillonner à plusieurs reprises (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
    ]
]

La comparaison avec la distribution théorique / asymptotique montre que tout correspond à peu près:

Show @ {
   theoreticalPlot,
   empiricalPlot
}