Unique List Summarized
- To: mathgroup at christensen.Cybernetics.NET
- Subject: [mg416] Unique List Summarized
- From: Don Piele <piele at cs.uwp.edu>
- Date: Sat, 21 Jan 1995 17:38:28 -0600 (CST)
Summary of the Unique List problem and a challenge
to solve the SlickDeal problem.
========================================
Robert B. Love on Mon, 26 Dec 94, in [mg358] Unique List asked:
OK, time for a little fun. I can generate a list of random
integers as Table[Random[Integer,{1,42}],{6}] and I get a list
6 elements long containing the integers from 1 to 42. But how
do I make sure no elements are repeated?
==================================================
Here are the type of solutions that were sumitted:
1) Use the built-in functions in the package:
<<DiscreteMath`Combinatorica`
Take[RandomPermutation[42],6]
{10, 18, 22, 24, 33, 41}
//by Richard Mercer
//by Robert Dickau
RandomKSubset[Range[1,42],6]
//by Benno Puetz
===================================================
2) Trial and Error {Keep trying until the selection has no duplication}
len=5;
While[len != 6,
hand = Table[Random[Integer,{1,42}],{6}];
len = Length[Union[hand]]
]
hand
// by Martin McClain
---- big problem if you try to pick 26 random numbers instead of 6 ---
Your algorithm terminates with probability 1, however, for any positive
integer n, the probability that the function you gave will not terminate
after calling Random n times, is positive.
// by Istvan Nemes
-------------------------------------
New[n_][s_] := If[Not[MemberQ[s, #]], Append[s,#],
New[n][s]]&[Random[Integer,{1,42}]]
// by Dana_Scott
-------------------------------------------------------------------------
3) nonrecursive procedural solution to the Lotto problem:
{ Pick random number from list, remove it, and repeat.}
l = Table[k, {k, 42}];
m = l; Table[j = Random[Integer, {l, Length[m]}];
k = m[[j]];
m = Delete[m, j]; k,
{6}]
// by Lou Talman
-------------------------------------
k=6;
n=42;
(S={};CS=Range[n];For[j=1,j<=k,j++,
AppendTo[S,x={CS[[ Random[Integer,{1,n-j+1}] ]]}];
CS=Complement[CS,x] ];Flatten[S])
// by donald darling
-------------------------------------
Lotto[n_,k_]:=(s=Range[n];
Table[x=Random[Integer,{1,i}];
{s[[i]],s[[x]]}={s[[x]],s[[i]]};
s[[i]],{i,n,n-k+1,-1}])
Lotto[42,6]
//by Steve Skiema --- Taken from his algorithm in the package:
DiscreteMath`Combinatorica` for RandomKSubsets and applied to this
problem.
----------------------------------------------------------------------------------
4) a purely functional procedure which simulates the way numbers
(if they were cards) could be mixed up and selected at random.
"Consider the numbers as cards from 1 to 42. Mix[numbers] by
doing a perfect shuffle followed by a random cut (RotateLeft). Nest this
process 10 times and (Take) the top 6 numbers."
Mix[x_List]:=RotateLeft[Transpose
[Partition[x,Length[x]/2]]//Flatten,
Random[Integer,{1,Length[x]}]]
Take[Nest[Mix[#]&,Range[42],10],6]
{23, 17, 22, 15, 30, 41}
//by D Piele
This procedure generalizes nicely to dealing n hands of k cards at
random from a standard deck.
Recently I posed the following problem in MiE.
E3. Slick Deal
Create a function SlickDeal[n,k] which will deal out n hands
of k cards from a standard deck of cards.
The standard deck is to be put in a list as follows
deck=Distribute[{{c,d,h,s},Range[2,10]~Join~{J,Q,K,A}},List]
{{c, 2}, {c, 3}, {c, 4}, {c, 5}, {c, 6}, {c, 7},
{c, 8}, {c, 9}, {c, 10}, {c, J}, {c, Q}, {c, K},
{c, A}, {d, 2}, {d, 3}, {d, 4}, {d, 5}, {d, 6},
{d, 7}, {d, 8}, {d, 9}, {d, 10}, {d, J}, {d, Q},
{d, K}, {d, A}, {h, 2}, {h, 3}, {h, 4}, {h, 5},
{h, 6}, {h, 7}, {h, 8}, {h, 9}, {h, 10}, {h, J},
{h, Q}, {h, K}, {h, A}, {s, 2}, {s, 3}, {s, 4},
{s, 5}, {s, 6}, {s, 7}, {s, 8}, {s, 9}, {s, 10},
{s, J}, {s, Q}, {s, K}, {s, A}}
-----------------------------------------------------------------
Solutions have been submitted that use the built-in
DiscreteMath`Combinatorica` package.
Can you come up with one that is purely functional, like the
one shown above, that used no packages?
My deadline for the next issue of MiE is Saturday Jan
28. If you have some new insights, I want to hear from
you.
Good Luck!
Don