Re: Q: extract all k-tuple from a list of n elements
- To: mathgroup at smc.vnet.net
- Subject: [mg49715] Re: Q: extract all k-tuple from a list of n elements
- From: koopman at sfu.ca (Ray Koopman)
- Date: Thu, 29 Jul 2004 07:43:36 -0400 (EDT)
- References: <ce2fv9$8rm$1@smc.vnet.net> <ce5di9$b7e$1@smc.vnet.net>
- Sender: owner-wri-mathgroup at wolfram.com
koopman at sfu.ca (Ray Koopman) wrote in message
news:<ce5di9$b7e$1 at smc.vnet.net>...
> In[1]:= subsets[n_,k_] := ToExpression["Flatten[Table[" <>
> ToString[Table["i"<>ToString[j],{j,k}]] <>
> Table[ ", {i"<>ToString[j] <>
> If[j==1, ",", ",i"<>ToString[j-1]<>"+1,"] <>
> ToString[n+j-k] <> "}", {j,k}] <>
> "]," <> ToString[k-1] <> "]"]
>
> In[2]:= subsets[5,3]
> Out[2]= {{1, 2, 3}, {1, 2, 4}, {1, 2, 5}, {1, 3, 4}, {1, 3, 5},
> {1, 4, 5}, {2, 3, 4}, {2, 3, 5}, {2, 4, 5}, {3, 4, 5}}
Here's another way to do it, using the built-in Permutations function.
It's slower than subsets, but not as slow as KSubsets.
In[3]:= subsetz[n_,k_] := Flatten@Position[#,1] & /@
Permutations@Join[Table[1,{k}],Table[2,{n-k}]]
In[4]:= Timing[Length[x = KSubsets[Range[15],5]]]
Out[4]= {8.18638 Second, 3003}
In[5]:= Timing[subsets[15,5] === x]
Out[5]= {1.51486 Second, True}
In[6]:= Timing[subsetz[15,5] === x]
Out[6]= {5.66863 Second, True}
This approach generalizes nicely to the case where we want to
split a set into several subsets, of sizes {k1,k2,...,km}.
In[7]:= subsetz[k_List] := With[{m = Length[k]},
Table[Flatten@Position[#,j],{j,m}] & /@
Permutations@Flatten[Table[j,{j,m},{k[[j]]}]]]
In[8]:= subsetz@{2,3}
Out[8]= {{{1,2},{3,4,5}}, {{1,3},{2,4,5}}, {{1,4},{2,3,5}},
{{1,5},{2,3,4}}, {{2,3},{1,4,5}}, {{2,4},{1,3,5}},
{{2,5},{1,3,4}}, {{3,4},{1,2,5}}, {{3,5},{1,2,4}},
{{4,5},{1,2,3}}}
In[9]:= subsetz[{2,2,2}]
Out[9]= {{{1,2},{3,4},{5,6}}, {{1,2},{3,5},{4,6}}, {{1,2},{3,6},{4,5}},
{{1,2},{4,5},{3,6}}, {{1,2},{4,6},{3,5}}, {{1,2},{5,6},{3,4}},
{{1,3},{2,4},{5,6}}, {{1,3},{2,5},{4,6}}, {{1,3},{2,6},{4,5}},
{{1,4},{2,3},{5,6}}, {{1,5},{2,3},{4,6}}, {{1,6},{2,3},{4,5}},
{{1,4},{2,5},{3,6}}, {{1,4},{2,6},{3,5}}, {{1,5},{2,4},{3,6}},
{{1,6},{2,4},{3,5}}, {{1,5},{2,6},{3,4}}, {{1,6},{2,5},{3,4}},
{{1,3},{4,5},{2,6}}, {{1,3},{4,6},{2,5}}, {{1,3},{5,6},{2,4}},
{{1,4},{3,5},{2,6}}, {{1,4},{3,6},{2,5}}, {{1,5},{3,4},{2,6}},
{{1,6},{3,4},{2,5}}, {{1,5},{3,6},{2,4}}, {{1,6},{3,5},{2,4}},
{{1,4},{5,6},{2,3}}, {{1,5},{4,6},{2,3}}, {{1,6},{4,5},{2,3}},
{{2,3},{1,4},{5,6}}, {{2,3},{1,5},{4,6}}, {{2,3},{1,6},{4,5}},
{{2,4},{1,3},{5,6}}, {{2,5},{1,3},{4,6}}, {{2,6},{1,3},{4,5}},
{{2,4},{1,5},{3,6}}, {{2,4},{1,6},{3,5}}, {{2,5},{1,4},{3,6}},
{{2,6},{1,4},{3,5}}, {{2,5},{1,6},{3,4}}, {{2,6},{1,5},{3,4}},
{{3,4},{1,2},{5,6}}, {{3,5},{1,2},{4,6}}, {{3,6},{1,2},{4,5}},
{{4,5},{1,2},{3,6}}, {{4,6},{1,2},{3,5}}, {{5,6},{1,2},{3,4}},
{{3,4},{1,5},{2,6}}, {{3,4},{1,6},{2,5}}, {{3,5},{1,4},{2,6}},
{{3,6},{1,4},{2,5}}, {{3,5},{1,6},{2,4}}, {{3,6},{1,5},{2,4}},
{{4,5},{1,3},{2,6}}, {{4,6},{1,3},{2,5}}, {{5,6},{1,3},{2,4}},
{{4,5},{1,6},{2,3}}, {{4,6},{1,5},{2,3}}, {{5,6},{1,4},{2,3}},
{{2,3},{4,5},{1,6}}, {{2,3},{4,6},{1,5}}, {{2,3},{5,6},{1,4}},
{{2,4},{3,5},{1,6}}, {{2,4},{3,6},{1,5}}, {{2,5},{3,4},{1,6}},
{{2,6},{3,4},{1,5}}, {{2,5},{3,6},{1,4}}, {{2,6},{3,5},{1,4}},
{{2,4},{5,6},{1,3}}, {{2,5},{4,6},{1,3}}, {{2,6},{4,5},{1,3}},
{{3,4},{2,5},{1,6}}, {{3,4},{2,6},{1,5}}, {{3,5},{2,4},{1,6}},
{{3,6},{2,4},{1,5}}, {{3,5},{2,6},{1,4}}, {{3,6},{2,5},{1,4}},
{{4,5},{2,3},{1,6}}, {{4,6},{2,3},{1,5}}, {{5,6},{2,3},{1,4}},
{{4,5},{2,6},{1,3}}, {{4,6},{2,5},{1,3}}, {{5,6},{2,4},{1,3}},
{{3,4},{5,6},{1,2}}, {{3,5},{4,6},{1,2}}, {{3,6},{4,5},{1,2}},
{{4,5},{3,6},{1,2}}, {{4,6},{3,5},{1,2}}, {{5,6},{3,4},{1,2}}}
In[10]:= Timing[First/@subsetz@{5,10} === x]
Out[10]= {15.0286 Second,True}
Note that subscripts are returned for all m subsets, which is redundant
and slows things down. Some time may -- or may not, depending on the
particular problem -- be saved by modifying the code to omit one of the
subsets, preferably the largest one.