Brainteaser Killer?

In Wilmott (serving the quantitative finance) you find a brainteaser forum. Due to the topic, problems are often related to stochastics. I draw just one of the recent questions: if you place a normal pack of cards (ie. 52 cards with no jokers) face down on a table and begin to turn over the cards (from the top) one at a time, calling out Ace when the first card is flipped, Two when the second card is flipped etc. right through to King (all irrespective of suit), and then repeating this four times, what is the chance of getting through the whole pack without calling a matching card?

Marco Carreira frequently gives explanatory answers in form of Mathematica programs.

called = Map[Mod[#, 13] &, Range[0, 51]]

{0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 0, 1, 2, 3, 4, 5, 6, 7, 8, \ 9, 10, 11, 12, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 0, 1, 2, 3, \ 4, 5, 6, 7, 8, 9, 10, 11, 12}

nrdraws = 1000000;

draws = Table[Map[Mod[#, 13] &, RandomSample[Range[0, 51], 52]], {nrdraws}];

matches = Table[MapThread[Boole[Equal[#1, #2]] &, {called, draws[[j]]}], {j, 1, nrdraws}];

Sort[Tally[Map[Total, matches]]]

{{0, 16175}, {1, 68929}, {2, 143830}, {3, 198761}, {4, 201272}, {5, 161134}, {6, 105438}, {7, 58535}, {8, 28166}, {9, 11655}, {10, 4119}, {11, 1394}, {12, 449}, {13, 108}, {14, 27}, {15, 7}, {16, 1}}

N[16175/nrdraws]

0.016175

He simulates 100000 random draw-cycles and counts the matches results (0, 1, 2, ... matches). I realyl like this. Describe the problem, instead of brooding on an exact solution. Mathematica is perfect for this.

No comments:

Post a Comment