Re: Re: Re: Re: Re:
- To: mathgroup at smc.vnet.net
- Subject: [mg103904] Re: [mg103883] Re: [mg103861] Re: [mg103827] Re: [mg103806] Re:
- From: DrMajorBob <btreat1 at austin.rr.com>
- Date: Mon, 12 Oct 2009 06:36:11 -0400 (EDT)
- References: <ha4r9k$d0h$1@smc.vnet.net> <200910071101.HAA00387@smc.vnet.net>
- Reply-to: drmajorbob at yahoo.com
Right you are. My bad again!
Bobby
On Sun, 11 Oct 2009 15:59:45 -0500, Leonid Shifrin <lshifr at gmail.com>
wrote:
> 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
>>>> 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
>>
--
DrMajorBob at yahoo.com
- References:
- Re: generating submultisets with repeated elements
- From: monochrome <bayard.webb@gmail.com>
- Re: generating submultisets with repeated elements