Services & ResourcesWolfram ForumsMathGroup Archive

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

Re: generating submultisets with repeated elements

• To: mathgroup at smc.vnet.net
• Subject: [mg103925] Re: generating submultisets with repeated elements
• From: DrMajorBob <btreat1 at austin.rr.com>
• Date: Tue, 13 Oct 2009 07:18:01 -0400 (EDT)
• References: <ha4r9k$d0h$1@smc.vnet.net> <200910071101.HAA00387@smc.vnet.net>
• Reply-to: drmajorbob at yahoo.com

Got it. I just missed the point in time where somebody changed the problem!

Bobby

On Mon, 12 Oct 2009 20:25:19 -0500, Kurt TeKolste <tekolste at fastmail.us>  
wrote:

> Binomial[n+k-1,k] is the number of non-decreasing series (i.e. repeats
> allowed) with *exactly* k choices from {1,...,n}.  The number of
> coinSets is the number of non-decreasing series with *at most* k choices
> (with repeats) from {1,...,n}, i.e
>
>   Sum[Binomial[n+i-1,i] , {i,1,k}]
>
> ekt
>
> Select On Mon, 12 Oct 2009 06:38 -0400, "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
>>
> Regards,
> Kurt Tekolste
>


-- 
DrMajorBob at yahoo.com

• References:
  • Re: generating submultisets with repeated elements
    • From: monochrome <bayard.webb@gmail.com>