เครื่องกำเนิดเลขสุ่มของ Mathematica เบี่ยงเบนจากความน่าจะเป็นทวินาม?

สมมติว่าคุณพลิกเหรียญ 10 ครั้งแล้วโทรหา 1 "เหตุการณ์" หากคุณเรียกใช้ 1,000,000 ของ "กิจกรรม" เหล่านี้สัดส่วนของเหตุการณ์ที่มีส่วนหัวระหว่าง 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 ( about ) ซึ่งเกี่ยวกับแบบจำลองของคุณ (ถูกต้อง ) ให้${{_{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"];

การทำงานกับการแจกแจงพารามิเตอร์

ตอนนี้เราสามารถกำหนดการแจกแจงเชิงเส้นกำกับสำหรับเหตุการณ์หนึ่งซึ่งเป็นสัดส่วนของหัวใน throws ของเหรียญ (ยุติธรรม):$\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}

ทำการทดลองของ Monte Carlo

เราสามารถใช้การแจกแจงสำหรับเหตุการณ์หนึ่งเพื่อสุ่มตัวอย่างซ้ำ ๆ จากมัน (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
    ]
]

การเปรียบเทียบสิ่งนี้กับการแจกแจงเชิงทฤษฎี / เชิงเส้นแสดงให้เห็นว่าทุกสิ่งที่เข้ากับ:

Show @ {
   theoreticalPlot,
   empiricalPlot
}