At a party N men throw their hats into the center of a room. The hats are mixed up and each man randomly selects one. Find the expected number of men who select their own hats.
Firstly let us define \(x\) as the sum of the number of men who got their hat correctly. In a group of \(n\) individuals, a person gets a \(1\) if he gets his own hat and \(0\) if not. The resultant would be the total number of men who get their own hats. \[x = \Sigma x_{i} : 1 \le i \le n\] \[E[x] = E[\Sigma x_{i}] = \Sigma E[x_{i}]\] Since each of the \(x_{i}\) is a bernoulli variable, the expectation of \(x_{i}\) is \[(1 * \frac{1}{n} ) + ( 0 * \frac{n-1}{n}) = \frac{1}{n} ⇒ \Sigma[x_{i}] = (n * \frac{1}{n}) = 1\]
We will now do a simulation of the example and see how the men get their hats when randomly choosing them. For the visualization, we will look at 26 people. The image shows several scenarios. The first line are the men who threw the hat. The the rows that follow are the various scenarios in which they picked up their hats. From the calculation above, in each scenario (or each row in the image), the expected match is one. Look through each row to see how many greens are there per row. Notice that is is around one.
ClearAll[listCompare];
listCompare[masterSample_List, randomSample_List] :=
Module[{alphabet = masterSample, sample = randomSample},
Table[
If[alphabet[[n]] == sample[[n]],
Style[sample[[n]], Darker@Green, Underlined, 15],
Style[sample[[n]], Red, 15]],
{n, 1, Length[sample]}]]
Module[{alphabet = Alphabet[], scenarios = Table[RandomSample[Alphabet[], 26], 100], reSelection, tableForm},
reSelection = {Style[#, Bold, 15] & /@ Alphabet[]}~Join~(listCompare[alphabet, #] & /@ scenarios);
reSelection = styledStringJoin[#, " | "] & /@ reSelection;
tableForm = TableForm@reSelection;
Export[StringReplace[NotebookFileName[], ".nb" -> ".png"], tableForm, ImageSize -> 788, ImageResolution -> 900]]
The image below shows a simulation done with 100000 trials. The bar chart shows the counts of occurrences in which correct selections were made (if any). Out of the 100000 trials in this experiment, In 37721 instances, one man chose his hat correctly In 35820 instances, none of the men chose their hat correctly In 18725 instances, two men chose their hat correctly In 6098 instances, three men chose their hat correctly and so on ..
Module[{list = Range[26], sample, barData, trials = 100000},
sample := RandomSample[list, Length@list];
barData = Reverse[Sort[Counts[
Table[Plus @@ Table[If[list[[n]] == sample[[n]], 1, 0], {n, 1, Length@list}], trials]]]];
BarChart[barData, ChartLabels -> Keys@barData, LabelingFunction -> (Placed[#, Above] &), PlotLabel -> ToString[trials] <> " trials"]]
Export[StringReplace[NotebookFileName[], ".nb" -> "_02.png"], %, ImageSize -> 788, ImageResolution -> 900]
The mean correct choices from this simulation is 1.0033 which is close enough to the expected value of 1.