Services & Resources / Wolfram Forums
-----
 /
MathGroup Archive
2004
*January
*February
*March
*April
*May
*June
*July
*August
*September
*October
*November
*December
*Archive Index
*Ask about this page
*Print this page
*Give us feedback
*Sign up for the Wolfram Insider

MathGroup Archive 2004

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

Search the Archive

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.


  • Prev by Date: Re: Launching the Mathematica interface via mathlink
  • Next by Date: a terdragon like Rauzy Pisot tile IFS
  • Previous by thread: Re: Q: extract all k-tuple from a list of n elements
  • Next by thread: GraphSum ignores edge colors?