Services & ResourcesWolfram ForumsMathGroup Archive

[Date Index] [Thread Index] [Author Index]

Re: Insoluble marbles-in-urn problem?

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

Surprising, perhaps, but also slow.

Here, I have reduced n and added Print statements to shows what you're  
actually doing:

Timing[rag = Table[x, {x, 1, 12}];
  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];
  Print@Transpose@{rag, selection, freq};
  Print@{bull, bullsort, bullsort[[1, 2]]};
  N[(Length[rag] - bullsort[[1, 2]])/Length[rag], 10]]

{{{1,4,0,3,7,6,8,7,5,4},0,1},{{7,9,9,9,9,4,5,3,8,8},8,2},{{7,2,1,3,0,0,4,7,7,3},3,2},{{0,1,3,2,2,6,8,3,0,0},2,2},{{1,4,7,2,8,0,2,8,4,9},8,2},{{2,2,2,3,6,6,4,7,7,0},6,2},{{2,8,7,2,6,1,9,5,5,3},3,1},{{3,6,6,0,5,8,6,0,3,6},0,2},{{4,0,5,8,8,0,0,3,5,6},4,1},{{2,4,1,9,4,1,2,6,8,6},9,1},{{0,8,0,6,3,5,0,9,3,7},3,2},{{8,5,6,1,5,8,4,0,3,8},1,1}}

{{{Characters[1],5},{Characters[2],7}},{{Characters[1],5},{Characters[2],7}},5}

{0.000677, 0.5833333333}

 From each draw of size ten, you've drawn a marble, then counted how many  
in the ten match that marble. "freq" collects those counts. "Characters"  
has no logical place in all this, but removing it makes no difference, so  
never mind.

"bullsort" in this case showed that "freq" was 1 five times and 2 seven  
times.

bullsort[[1,2]] counts how many times "freq" was its minimum value. In  
this case, the minimum is 1.

Length@rag - bullsort[[1,2]] / Length@rag == (12 - 5) / 12 == 7 / 12 ==  
0.58333

If the minimum is 1 -- as it usually WILL be in a sample of size one  
million -- this is the probability that it is possible to draw the same  
number a second time. (The minimum is not NECESSARILY 1, of course.)

Here's a faster, simpler code:

Clear[p]
p[1] := Module[{ten = RandomInteger[{0, 9}, 10]},
   Boole[Count[ten, RandomChoice@ten] > 1]
   ]
p[n_] /; n <= 10^6 := Mean@Array[p[1] &, n]
p[n_] := Module[{k = Round[n/2]}, {k, n - k}.{p[k], p[n - k]}/n]
Timing@p[10^7]
N@Last@%

{6.67044, 6123121/10000000}

0.612312

Timing@p[10^8]
N@Last@%

{65.5279, 61259847/100000000}

0.612598

I suspect the theoretical result is

1. - (9/10)^9

0.61258

but I'm not sure. I'm looking into it.

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>