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

9

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?

Tim McKnight
la source
3
peut-être que ce serait mieux adapté à mathématique stackexchange mathematicica.stackexchange.com
Jeromy Anglim
1
@JeromyAnglim Dans ce cas, je soupçonne que le problème vient probablement du raisonnement plutôt que du codage strict.
Glen_b -Reinstate Monica
@Glen_b Je suppose que l'essentiel est qu'il existe une bonne réponse quelque part sur Internet, que vous semblez avoir fournie. :-)
Jeromy Anglim

Réponses:

19

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.(105)(12)100.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.

Glen_b -Reinstate Monica
la source
Ironiquement, @TimMcKnight a démontré une probabilité binomiale pour nous.
Simon Kuang
8

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 utiliserxp^=x/10x=5Pr[4X6]=6 x=4 ( 10

Pr[X=5]=(105)(0.5)5(10.5)50.246094.
Pr[4X6]=x=46(10x)(0.5)x(10.5)10x=67210240.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.

heropup
la source
2
Vous pouvez accélérer votre code d'un autre facteur 10 en utilisant Total@Map[Counts@RandomVariate[BinomialDistribution[10, 1/2], 10^6], {4, 5, 6}]. Je soupçonne Counts[]qu'étant une fonction intégrée, elle est hautement optimisée par rapport à celle Select[]qui doit fonctionner avec des prédicats arbitraires.
David Zhang
1

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):nπ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: ThéoreticsDistributionPlot

Nous pouvons utiliser la distribution immédiatement pour calculer les probabilités pour et :Pr[Pr[0.4π0.6|πB(10,12)]Pr[0.4<π<0.6|πB(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}

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

EmpirialDistributionPlot

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

Show @ {
   theoreticalPlot,
   empiricalPlot
}

Comparaison des distributions

gwr
la source
Vous pouvez trouver un article similaire avec plus d'informations sur Mathematica sur Mathematica SE .
gwr