Services & ResourcesWolfram ForumsMathGroup Archive

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

Re: generating submultisets with repeated elements

• To: mathgroup at smc.vnet.net
• Subject: [mg103923] Re: generating submultisets with repeated elements
• From: "Kurt TeKolste" <tekolste at fastmail.us>
• Date: Tue, 13 Oct 2009 07:17:33 -0400 (EDT)
• References: <ha4r9k$d0h$1@smc.vnet.net> <200910071101.HAA00387@smc.vnet.net>

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

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