All about flooble | fun stuff | Get a free chatterbox | Free JavaScript | Avatars    
perplexus dot info

Home > Probability
One 1 to Six 6's (Posted on 2015-07-01) Difficulty: 4 of 5
A standard six-sided die is to be rolled repeatedly until a side appears a number of times equal to its number. In other words until the n-th n appears.

Let P(n)=the probability the game terminates with the n-th n.

Find the distribution of n.

Feel free to generalize for m sides.

Warning: I have not managed this past m=4.

No Solution Yet Submitted by Jer    
No Rating

Comments: ( Back to comment list | You must be logged in to post comments.)
re(5): computer aided solution (lots more) | Comment 9 of 14 |
(In reply to re(4): computer aided solution by Charlie)

I figured out a computational shortcut to calculating the probabilities. 


Now assume that the game ends where value 1 occurs s1 times, 2 s2 times and so on to n occuring s_n times.  Now if the game ended with value k being rolled then that means s_k=k and s_t<t for all other t.

The odds of this happening can be calculated as
(s1+s2+...+s_n)!/(s1*s2*...*s_n!)*(1/n)^(s1+s2+...+s_n)

Now to get the complete probability for a given k we simply sum this individual probability over all possible combinations of values of the other s_t.  As it turns out this number of combinations does not explode nearly as quickly.

Taking this approach, I made this function in Mathematica whicle builds the nested summation expression for a given n,s and then uses that to calculate the probabilities.  I also calculate the ratio of consecutive probabilities.

p[n_, s_] := Module[{ex, i, a},
   ex = "Sum[(s1";
   For[i = 2, i <= n, ++i,
    ex = ex <> "+s" <> ToString[i];
    ];
   ex = ex <> ")!/(s1!";
   For[i = 2, i <= n, ++i,
    ex = ex <> "*s" <> ToString[i] <> "!";
    ];
   ex = ex <> ")*(1/" <> ToString[n] <> ")^(s1";
   For[i = 2, i <= n, ++i,
    ex = ex <> "+s" <> ToString[i];
    ];
   ex = ex <> "+1)";
   For[i = 1, i <= n, ++i,
    If[i == s, a = i - 1, a = 0;];
    ex = ex <> ",{s" <> ToString[i] <> "," <> ToString[a] <> "," <> 
      ToString[i - 1] <> "}";
    ];
   ex = ex <> "]";
   Return[ToExpression[ex]];
   ];

My next post I will give the results so far (I'm having it run up to 20-sided die and so far it has completed for 10-sides)

  Posted by Daniel on 2015-07-03 21:00:09
Please log in:
Login:
Password:
Remember me:
Sign up! | Forgot password


Search:
Search body:
Forums (0)
Newest Problems
Random Problem
FAQ | About This Site
Site Statistics
New Comments (8)
Unsolved Problems
Top Rated Problems
This month's top
Most Commented On

Chatterbox:
Copyright © 2002 - 2017 by Animus Pactum Consulting. All rights reserved. Privacy Information