Probability | Expectation | Unique Discount Coupons


Question

Suppose there are 25 different types of coupons and suppose that each time one obtains a coupon, it is equally likely to be any one of the 25 types. Compute the expected number of different types that are contained in a set of 10 coupons.


Numerical Approach

It was a little difficult to understand the text’s interpretation of the problem so here is another way. Imagine it this way, there are 25 different coupons and we need to calculate the probability of any of those coupons to make it to the list of 10. Or, we can also say that the probability that the number of coupons in the set of 10 is one. Sum them up and we would get the expected number of different coupons. Just like the previous example, we get

\[x = \Sigma x_{i} : 1 \le i \le 25\] \[E[x] = E[\Sigma x_{i}] = \Sigma E[x_{i}]\] \[E[x_{i}] = 1 – (\frac{24}{25})^{10}\] \[\implies \Sigma [x_{i}] = 25 * (1 – (\frac{24}{25})^{10}) \approx 8.37918\]


Simulation

This part is very straightforward. We will create a list of numbers from 1 through 25 and do a random choice of 10 instead of a random sample of 10. This would mean that you are allowing the program to repeat the selection of the numbers from the master list of 1 through 25. We repeat this process a bunch of times. Then we do a union of each set of 10 and count the number of unique coupons in each of the set. Let us see how the simulation brings out the answer.


    Module[{coupons = Range[25], barData, trials = 1000000},
        barData = Reverse@Sort@ Counts[Length /@ Union /@ RandomChoice[coupons, {trials, 10}]];
        Labeled[BarChart[barData, ChartLabels -> Keys@barData,
            LabelingFunction -> (Placed[#, Above] &),
            AxesLabel -> {None, Style["Count", 15]}, ImageSize -> 788,
            PlotLabel -> ToString[trials] <> " trials", Frame -> True], "Number of unique coupons"]
    ]

    Export[StringReplace[NotebookFileName[], ".nb" -> ".svg"], %, ImageSize -> 788]

Calculation wise, for a million trials, the answer turns out to be 8.38043 which is close to the calculated answer of 8.37918. Code for the calculation is give below


    Module[{coupons = Range[25], barData, trials = 1000000},
        barData = N@Mean[Length /@ Union /@ RandomChoice[coupons, {trials, 10}]]]