Re: generating submultisets with repeated elements
- To: mathgroup at smc.vnet.net
- Subject: [mg103995] Re: generating submultisets with repeated elements
- From: David Bevan <david.bevan at pb.com>
- Date: Thu, 15 Oct 2009 07:15:29 -0400 (EDT)
- References: <ha4r9k$d0h$1@smc.vnet.net>
Leonid,
This is certainly the fastest so far:
Transpose[Transpose[Subsets[Range[n+k-1],{k}]]-Range[0,k-1]]
Thanks.
David %^>
________________________________________
From: Leonid Shifrin [lshifr at gmail.com]
Sent: 12 October 2009 11:38
To: mathgroup at smc.vnet.net
Subject: [mg103995] [mg103917] Re: [mg103883] Re: [mg103861] Re: [mg103827] Re: [mg103806] Re:
Hi Bobby,
My code does not do anything new, it just optimizes the code and ideas
expressed before in this thread. My guess is that you are comparing
different things:
1. My code (and David's original coinSets) computes all subsets of length
*up to* K, and is already a lump sum of contributions for k=1,2,...,K, while
other's code is concerned with a fixed k case (subsets of the fixed length
k). It is subMultiSetsNew that has to be compared with other's solutions, in
terms of number of subsets.
In[1]:= subMultiSetsNew[Range[15],7]//Length
Out[1]= 116280
Agrees with your benchmark
2. My code (and David's coinSets) both give subsets of an arbitrary
list, while other's code look at the positions - so that code needs another
step of extracting elements by their positions in subsets - this step
requires additional time. When you add the definition
coinSetsNew[n_Integer, k_] := coinSetsNew[Range@n, k]
(which wasn't there in my original code), this slows the function down with
respect to what it could be, were I interested in just positions: in this
case, I would skip the Partition[s[[Flatten[#]]], k] call in
subMultiSetsNew (as I do below).
When you sum the contributions of different k = 1,...,K, and include the
original elements extraction step, the number of subsets will be the same as
in David's and mine solutions, while the timings will likely be worse than
mine, since more operations are performed in other solutions. Here is the
benchmark you did, with the fastest of the previous solutions vs mine (mine
with the following modification):
Clear[subMultiSetsPositions];
subMultiSetsPositions[s_List, k_] :=
Transpose[Transpose[Subsets[Range[Length[s] + k - 1], {k}]] -
Range[0, k - 1]];
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]]
In[2] =
n = 15;
k = 7;
Timing@Length@(res1 = MSN3[n, k])
Timing@Length@(res2 = subMultiSetsPositions[Range[n], k])
Out[2]= {0.56, 116280}
Out[3]= {0.151, 116280}
In[4]:= res1 == res2
Out[4]= True
Regards,
Leonid.
On Sun, Oct 11, 2009 at 1:24 PM, DrMajorBob <btreat1 at austin.rr.com> wrote:
> 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 wi=
th
>>> > 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
>=