5
$\begingroup$

I am teaching a basic introduction to normal curves, and the textbook introduces the topic with the idea of rolling five dice and recording the sum. Do this many times and create a histogram of the results. (which looks more and more like the normal curve as the number of trials increases) My "code" to simulate this for 10000 rolls is below.

rolls = Table[Table[RandomChoice[Range[6]], {5}], {10000}];
sums = Total /@ rolls;
Histogram[sums, {0.5, 31.5, 1}]

I am way out of my depth here, but wondered if anyone could help with how to plot the "perfect" normal curve that would match the histogram?

I have the following to plot a normal curve, but for it to match the dice example, I need the mean and standard deviation, and how no idea what that would be.

Plot[PDF[NormalDistribution[0, 1], x], {x, -3, 3}, Ticks -> None, 
 Axes -> None]

Any help is appreciated.

$\endgroup$
0
5
$\begingroup$

With your definitions of rolls and sums, you can find the parameters for the corresponding normal distribution by calculating the mean and standard deviation of sums directly, using Mean and StandardDeviation, or more generally using FindDistributionParameters:

pdf = PDF[NormalDistribution[mu, sigma] /. 
   FindDistributionParameters[sums, NormalDistribution[mu, sigma]]]

With those in hand, you can plot the histogram and the PDF of the calculated distribution. Here I shown them both scaled as PDFs:

Show[
 Plot[pdf[x], {x, 0, 35}, PlotStyle -> Directive[Thickness[0.01], Red]],
 Histogram[sums, {0.5, 31.5, 1}, "PDF"]
]

combined histogram and pdf

Alternatively if you want it expressed in counts, you have to account for the total number of rolls:

Show[
 Plot[10000 pdf[x], {x, 0, 35}, PlotStyle -> Directive[Thickness[0.01], Red]],
 Histogram[sums, {0.5, 31.5, 1}]
]

overlay of histogram and PDF scaled for counts


Incidentally, I would recommend calculating rolls in one go as follows, rather than with nested tables:

rolls = RandomChoice[Range[6], {10000, 5}];
$\endgroup$
4
$\begingroup$

Here's a way to take advantage of some of the built-in probability stuff. I couldn't find or remember what distribution does the sum of dice. TransformedDistribution didn't work (or I made an error). Note: For the normal distribution, we use the theoretical mean and standard deviation instead of empirical estimates of them based on sample sum.

dicedist = DiscreteUniformDistribution[Table[{1, 6}, {5}]];

(* roll the dice *)
RandomVariate[dicedist]
(*  {1, 6, 4, 6, 5}  *)

mu = Total@Mean[dicedist];
sd = Sqrt@Total@Variance[dicedist];

Show[
 Histogram[Total /@ RandomVariate[dicedist, 2000], Automatic, "PDF"],
 Plot[PDF[NormalDistribution[mu, sd], x], {x, 5, 30}]
 ]

enter image description here

An interactive demonstration:

Manipulate[
 Show[
  Histogram[Total /@ RandomVariate[dicedist, n], Automatic, "PDF"],
  Plot[PDF[NormalDistribution[mu, sd], x], {x, 5, 30}],
  PlotRange -> {{4.5, 30.5}, {-0.01, 
     1.5 PDF[NormalDistribution[mu, sd], mu]}},
  Frame -> True, PlotLabel -> HoldForm["n" == #] &@n, Axes -> False
  ],
 {n, 20, 10000, 10}]
$\endgroup$
3
$\begingroup$
rolls = Table[Table[RandomChoice[Range[6]], {5}], {10000}];
sums = Total /@ rolls;
fig1 = Histogram[sums, {0.5, 31.5, 1}, "PDF"];
mean = Mean@sums;
std = StandardDeviation@sums;
fig2 = Plot[PDF[NormalDistribution[mean, std], x], {x, 0, 30}, 
   Ticks -> None, Axes -> None];
Show[{fig1 , fig2}]

enter image description here

If you wanna use count, then

rolls = Table[Table[RandomChoice[Range[6]], {5}], {10000}];
sums = Total /@ rolls;
fig1 = Histogram[sums, {0.5, 31.5, 1}];
mean = Mean@sums;
std = StandardDeviation@sums;
fig2 = Plot[PDF[NormalDistribution[mean, std], x], {x, 0, 30}, 
   Ticks -> None, Axes -> None];
Overlay[{fig1 , fig2}]

enter image description here

$\endgroup$
3
  • $\begingroup$ Why does the normal curve look like it results in negative values in the tail regions? $\endgroup$
    – JimB
    Nov 26 '20 at 4:11
  • 1
    $\begingroup$ @JimB I think the ImagePadding needs to be specified (and the same) for both plots in order to use Overlay. $\endgroup$
    – MassDefect
    Nov 26 '20 at 5:17
  • $\begingroup$ @MassDefect: That makes sense (and I assume that's in part because of the Axes->None option in fig2). Maybe using 10000 PDF[NormalDistribution[mean, std], x] in fig2 and Show[fig1,fig2] would be better. $\endgroup$
    – JimB
    Nov 26 '20 at 5:31

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.