WOLFRAM

Services & Resources / Wolfram Forums / MathGroup Archive

MathGroup Archive 2009

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

Search the Archive

Re: Re: Re: Re: Re:

  • To: mathgroup at smc.vnet.net
  • Subject: [mg103916] Re: [mg103883] Re: [mg103861] Re: [mg103827] Re: [mg103806] Re:
  • From: DrMajorBob <btreat1 at austin.rr.com>
  • Date: Mon, 12 Oct 2009 06:38:27 -0400 (EDT)
  • References: <ha4r9k$d0h$1@smc.vnet.net> <200910071101.HAA00387@smc.vnet.net>
  • Reply-to: drmajorbob at yahoo.com
Leonid,

In my tests, that code returns too many subsets, and so does David's  
coinSets... unless Binomial[n + k - 1, k] is the wrong count, and the  
earlier methods were wrong.

<< "Combinatorica`";

Clear[f, g, test1, test2, test3]
f[set_] := Table[set[[i]] - (i - 1), {i, Length[set]}]
g[set_] := set - Range[0, Length@set - 1]
test1[n_, k_] := f /@ KSubsets[Range[n + k - 1], k]
test2[n_, k_] := g /@ KSubsets[Range[n + k - 1], k]
test3[n_, k_] := g /@ Subsets[Range[n + k - 1], {k}]

(* David Bevan *)

msNew[s_List, k_] :=
  Flatten[Flatten[
      Outer[Inner[ConstantArray, #1, #2, Flatten[List[##], 1] &, 1] &,
       Subsets[s, {Length[#[[1]]]}], #, 1], 1] & /@
    Split[Flatten[Permutations /@ IntegerPartitions[k], 1],
     Length[#1] == Length[#2] &], 1]
coinSets[s_List, k_] := Join @@ Table[msNew[s, i], {i, k}]
coinSets[n_Integer, k_] := coinSets[Range@n, k]

(* David Bevan *)
Clear[MSN3, MSN3Base]
MSN3Base =
   Compile[{{n, _Integer}, {k, _Integer}},
    Module[{h, ss = ConstantArray[1, k]}, Table[(h = k;
       While[n === ss[[h]], h--];
       ss =
        Join[Take[ss, h - 1],
         ConstantArray[ss[[h]] + 1, k - h + 1]]), {Binomial[n + k - 1,
         k] - 1}]]];
MSN3[n_, k_] := Prepend[MSN3Base[n, k], ConstantArray[1, k]]

(* Ray Koopman *)

MSN3a[n_, k_] := Join[{Table[1, {k}]}, MSN3Base[n, k]]

(* Leonid Shifrin: *)
Clear[subMultiSetsNew, coinSetsNew];
subMultiSetsNew[s_List, k_] :=
   Partition[s[[Flatten[#]]], k] &@
    Transpose[
     Transpose[Subsets[Range[Length[s] + k - 1], {k}]] -
      Range[0, k - 1]];
coinSetsNew[s_List, k_] :=
   Flatten[Table[subMultiSetsNew[s, i], {i, k}], 1];
coinSetsNew[n_Integer, k_] := coinSetsNew[Range@n, k]

n = 15; k = 7;
Timing@Length@test3[n, k]
Timing@Length@coinSets[n, k]
Timing@Length@MSN3[n, k]
Timing@Length@MSN3a[n, k]
Timing@Length@coinSetsNew[n, k]
Binomial[n + k - 1, k]

{0.906038, 116280}

{1.34786, 170543}

{0.130817, 116280}

{0.135289, 116280}

{0.23856, 170543}

116280

n = 15; k = 10;
Timing@Length@test3[n, k]
Timing@Length@coinSets[n, k]
Timing@Length@MSN3[n, k]
Timing@Length@MSN3a[n, k]
Timing@Length@coinSetsNew[n, k]
Binomial[n + k - 1, k]

{15.3937, 1961256}

{29.7325, 3268759}

{2.47349, 1961256}

{2.33108, 1961256}

{5.32499, 3268759}

1961256

Bobby

On Sat, 10 Oct 2009 06:10:29 -0500, Leonid Shifrin <lshifr at gmail.com>  
wrote:

> I've made a few more optimizations:
>
> Clear[subMultiSetsNew];
> subMultiSetsNew[s_, k_] :=
>   Partition[s[[Flatten[#]]], k] &@
>    Transpose[
>     Transpose[Subsets[Range[Length[s] + k - 1], {k}]] -
>      Range[0, k - 1]];
>
> Clear[coinSetsNew];
> coinSetsNew[s_, k_] :=
>   Flatten[Table[subMultiSetsNew[s, i], {i, k}], 1];
>
> Now (coinSets is  David's "accumulator" version):
>
> In[1]:= (res1=coinSets[Range[15],7])//Length//Timing
>
> Out[1]= {2.333,170543}
>
> In[2]:= (res2 = coinSetsNew[Range[15],7])//Length//Timing
> Out[2]= {0.37,170543}
>
> In[3]:= res1==res2
>
> Out[3]= True
>
> Regards,
> Leonid
>
>
>
>
>
>
>
> On Fri, Oct 9, 2009 at 4:18 AM, David Bevan <david.bevan at pb.com> wrote:
>
>>
>> ... and using Subsets[set, {k}] is much faster than KSubsets[set, k]
>>
>>
>> > -----Original Message-----
>> > From: DrMajorBob [mailto:btreat1 at austin.rr.com]
>> > Sent: 8 October 2009 17:05
>> > To: David Bevan; mathgroup at smc.vnet.net
>> > Cc: bayard.webb at gmail.com
>> > Subject: Re: [mg103827] Re: [mg103806] Re: generating submultisets  
>> with
>> > repeated elements
>> >
>> > g is an improvement over f, I think:
>> >
>> > << "Combinatorica`";
>> >
>> > Clear[f, g, test1, test2]
>> > f[set_] := Table[set[[i]] - (i - 1), {i, Length[set]}]
>> > g[set_] := set - Range[0, Length@set - 1]
>> > test1[n_, k_] := With[{set = Range[n + k - 1]},
>> >    f /@ KSubsets[set, k]]
>> > test2[n_, k_] := With[{set = Range[n + k - 1]},
>> >    g /@ KSubsets[set, k]]
>> >
>> > n = 15; k = 10;
>> > Timing@Length@test1[n, k]
>> > Timing@Length@test2[n, k]
>> > Binomial[n + k - 1, k]
>> >
>> > {32.9105, 1961256}
>> >
>> > {16.3832, 1961256}
>> >
>> > 1961256
>> >
>> > Bobby
>> >
>> > On Thu, 08 Oct 2009 06:50:51 -0500, David Bevan <david.bevan at pb.com>
>> > wrote:
>> >
>> > > That's an interesting bijection I wasn't aware of. Thanks.
>> > >
>> > > David %^>
>> > >
>> > >> -----Original Message-----
>> > >> From: monochrome [mailto:bayard.webb at gmail.com]
>> > >> Sent: 7 October 2009 12:02
>> > >> To: mathgroup at smc.vnet.net
>> > >> Subject: [mg103806] Re: generating submultisets with repeated  
>> elements
>> > >>
>> > >> I did a little research and found out that there are Choose(n+k-1,  
>> k)
>> > >> multisets of size k from a set of size n. This made me think that
>> > >> there should be a mapping from the k-subsets of n+k-1 to the k-
>> > >> multisets of n. A few quick examples led me to the following  
>> function:
>> > >>
>> > >> f[set_] := Table[set[[i]] - (i - 1), {i, Length[set]}]
>> > >>
>> > >> This allows the following construction using the KSubsets function
>> > >> from Combinatorica:
>> > >>
>> > >> << "Combinatorica`";
>> > >> n = 6;
>> > >> k = 3;
>> > >> set = Range[n + k - 1];
>> > >> Map[f, KSubsets[set, k]]
>> > >>
>> > >> ===OUTPUT===
>> > >> {{1, 1, 1}, {1, 1, 2}, {1, 1, 3}, {1, 1, 4}, {1, 1, 5}, {1, 1, 6},  
>> {1,
>> > >>    2, 2}, {1, 2, 3}, {1, 2, 4}, {1, 2, 5}, {1, 2, 6}, {1, 3, 3},  
>> {1,
>> > >>   3, 4}, {1, 3, 5}, {1, 3, 6}, {1, 4, 4}, {1, 4, 5}, {1, 4, 6},  
>> {1, 5,
>> > >>    5}, {1, 5, 6}, {1, 6, 6}, {2, 2, 2}, {2, 2, 3}, {2, 2, 4}, {2,  
>> 2,
>> > >>   5}, {2, 2, 6}, {2, 3, 3}, {2, 3, 4}, {2, 3, 5}, {2, 3, 6}, {2, 4,
>> > >>   4}, {2, 4, 5}, {2, 4, 6}, {2, 5, 5}, {2, 5, 6}, {2, 6, 6}, {3, 3,
>> > >>   3}, {3, 3, 4}, {3, 3, 5}, {3, 3, 6}, {3, 4, 4}, {3, 4, 5}, {3, 4,
>> > >>   6}, {3, 5, 5}, {3, 5, 6}, {3, 6, 6}, {4, 4, 4}, {4, 4, 5}, {4, 4,
>> > >>   6}, {4, 5, 5}, {4, 5, 6}, {4, 6, 6}, {5, 5, 5}, {5, 5, 6}, {5, 6,
>> > >>   6}, {6, 6, 6}}
>> > >>
>> > >
>> >
>> >
>> > --
>> > DrMajorBob at yahoo.com
>>
>>
>>
>


-- 
DrMajorBob at yahoo.com
  • Prev by Date: Re: Re: How to find which variable caused the trigger in Manipulate[]
  • Next by Date: Re: Re: Re: undocumented feature: TableView
  • Previous by thread: Re: Re: generating submultisets with repeated elements
  • Next by thread: Re: Re: Re: Re: Re: