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>
- Insoluble marbles-in-urn problem?