Consider an experiment that consists of counting the number of \(\alpha\)-particles given off in a one-second interval by one gram of radioactive material. If we know from past experience that, on the average, 3.2 such \(\alpha\)-particles are given off, what is a good approximation to the probability that no more than two α-particles will appear?
The question is asking for the probability that the no more than two α-particles will appear. This is written as \[P\{X \le 2\} = \Sigma e^{-\lambda} \frac{\lambda^{x}}{x!}: 0 \le x \le 2\] and the summation gives the value \(\approx\) 0.382
Longer waiting times will stabilize mean and this apparent from the figure below. The distributions of the probabilities get tighter around the calculated value of 0.382 as the waiting times increase.
counter[count_] := Module[{data = RandomVariate[PoissonDistribution[3.2], count]}, Length[Select[data, # <= 2 &]]/count]
DistributionChart[
Table[counter[#], 1000] & /@ {5, 10, 20, 50, 100, 200, 500, 1000},
ChartElementFunction -> "HistogramDensity",
ChartLabels -> {5, 10, 20, 50, 100, 200, 500, 1000},
PlotLabel -> "P{x\[LessEqual]2} with the number of seconds of waiting time"
]
Let us say that you are a scientist observing the accumulation of these alpha particles and you allow them to accumulate over time. You do several set of experiments to see how the mean values are approached at the limiting case by running the experiment for a very long time. There are multiple ways to look at it but we will do it in the following way.
Reading the plot: All the mean values start at 12 o’Clock position and observe that the variation is very high at this point since the system has not stabilized yet. As the time progresses, the system stabilizes and the mean values approach the theoretical value of 3.2. Note that the thick red band is the theoretical limit. Several of these systems are randomly varying about the radius of 3.2.
This plot has been constructed from scratch and you can do it too! Check the code below.
ClearAll[cumulativeRange, radialLine];
cumulativeRange[list_List] := Accumulate[list]/Range[Length@list];
radialLine[data_] := {Opacity[0.05], Thickness[0], Line[Table[{data[[r]] Sin[2 r \[Degree]], data[[r]] Cos[2 r \[Degree]]}, {r, 1, Length@data}]]};
Export[NotebookDirectory[] <> "poisson_01.png",
Module[{data = Table[cumulativeRange[RandomVariate[PoissonDistribution[3.2], 180]], 500]},
Graphics[Join @@ {
{Red, Thickness[0.005], Circle[{0, 0}, 3.2]},
{Opacity[0.01], Black, Thickness[0], radialLine[#] & /@ data}},
Frame -> True]],
ImageSize -> 754
]