Re: Insoluble marbles-in-urn problem?

*To*: mathgroup at smc.vnet.net*Subject*: [mg119987] Re: Insoluble marbles-in-urn problem?*From*: DrMajorBob <btreat1 at austin.rr.com>*Date*: Mon, 4 Jul 2011 06:44:14 -0400 (EDT)*References*: <201107030811.EAA21357@smc.vnet.net>*Reply-to*: drmajorbob at yahoo.com

Here's an improvement for calculating the theoretical value: Clear[q] tenths = ConstantArray[1/10, 10]; q[x_List, y_] := Boole[y > 1] y/10 q[x_List] /; Length@x == 10 := Total[q[x, #] & /@ x] PDF[MultinomialDistribution[10, tenths], x] q[x_List] := Module[{long = PadRight[x, 10]}, Multinomial @@ Tally[long][[All, -1]] q@long] Timing[q /@ IntegerPartitions@10 // Total] % // Last // N {0.010595, 612579511/1000000000} 0.61258 That still matches 1 - (9/10)^9 612579511/1000000000 Bobby On Sun, 03 Jul 2011 14:27:22 -0500, DrMajorBob <btreat1 at austin.rr.com> wrote: > This matches my earlier guess: > > Clear[q] > tenths = ConstantArray[1/10, 10]; > q[x_List, y_] := Boole[y > 1] y/10 > q[x_List] /; Length@x == 10 := > Total[q[x, #] & /@ x] PDF[MultinomialDistribution[10, tenths], x] > q[x_List] := > Module[{long = PadRight[x, 10]}, Length@Permutations@long q@long] > q /@ IntegerPartitions@10 // Total > % // N > > 612579511/1000000000 > > 0.61258 > > 1 - (9/10)^9 > > 612579511/1000000000 > > Bobby > > On Sun, 03 Jul 2011 03:11:34 -0500, John Feth <johnfeth at gmail.com> wrote: > >> There is a huge urn full of marbles, each marked with a single digit: >> 0, 1, 2, 3, 4, 5, 6, 7, 8, or 9. The marked marble quantities are >> uniformly distributed between all of the digits and the marbles are >> thoroughly mixed. You look away, choose 10 marbles, and put them in a >> black velvet bag. >> >> When you have some time, you look away, open the bag, and remove one >> marble. You close the bag, look at the digit on the marble, open a >> beer perhaps, and calculate the probability that there is at least one >> more marble in the bag with the same digit. >> >> The answer is brute forced below is there a formal way to obtain the >> answer? I don't believe the marbles-in-urn standby, the >> hypergeometric distribution, is any help at all. >> >> Copy and paste the algorithm below into Mathematica (V6 or newer) to >> find the surprising answer, estimated from a million tests in about 16 >> seconds. >> >> Timing[rag=Table[x,{x,1,1000000}];For[i=1,i<Length[rag]+1,i+ >> +,rag[[i]]=Table[RandomInteger[{0,9}],{n,1,10}]];bug=Table[x,{x, >> 1,Length[rag]}];For[i=1,i<Length[rag]+1,i+ >> +,bug[[i]]=RandomInteger[{1,10}]];selection=Table[rag[[i,bug[[i]]]],{i, >> 1,Length[rag]}];freq:=Table[Count[rag[[i]],selection[[i]]],{i, >> 1,Length[rag]}];bull=Tally[Characters[freq]];bullsort=Sort[bull];N[(Length[rag]- >> bullsort[[1,2]])/Length[rag],10]] >> >> Below are some definitions that might make the algorithm above a >> little less opaque. >> >> rag is a table of 10 digit random strings below >> >> (*rag=Table[x,{x,1,3}];For[i=1,i<Length[rag]+1,i+ >> +,rag[[i]]=Table[RandomInteger[{0,9}],{n,1,10}]];rag >> {{9,6,5,3,4,9,1,7,4,3},{8,5,7,7,0,0,5,6,3,5},{1,1,8,0,9,0,4,3,4,3}}*) >> >> bug is a table of which digit to pick from each rag[ [ ] ] above, i.e. >> the 4th from the left in rag[[1]], the 2nd from the left in rag[[2]], >> etc. >> >> (*bug=Table[x,{x,1,Length[rag]}];For[i=1,i<Length[rag]+1,i+ >> +,bug[[i]]=RandomInteger[{1,10}]];bug >> {4,2,5}*) >> >> selection is a table of the values of the digit picked above, i.e., >> the 4th digit in rag[[1]] is a 3, the 2nd digit in rag[[2]] is a 5, >> etc. >> >> (*selection=Table[rag[[i,bug[[i]]]],{i,1,Length[rag]}] >> {3,5,9}*) >> >> freq is a table of the number selected digits in rag[[n]], i.e., there >> are two 3s in rag[[1]], three 5s in rag[[2]], one 9 in rag[[3]], etc. >> >> (*freq=Table[Count[rag[[i]],selection[[i]]],{i,1,Length[rag]}] >> {2,3,1}*) >> >> bull tallies how many times the chosen digit occurs >> >> (*bull=Tally[Characters[freq]] >> {{Characters[2],1},{Characters[3],1},{Characters[1],1}}*) >> >> bullsort tallies the number of times the chosen digit occurs; the >> chosen digit occurred once one time (9's above), twice one time (4's >> above), and once three times (5's above) >> >> (*bullsort=Sort[bull] >> {{Characters[1],1},{Characters[2],1},{Characters[3],1}}*) >> >> > > -- DrMajorBob at yahoo.com

**References**:**Insoluble marbles-in-urn problem?***From:*John Feth <johnfeth@gmail.com>