Re: generating submultisets with repeated elements

• To: mathgroup at smc.vnet.net
• Subject: [mg104028] Re: generating submultisets with repeated elements
• From: Raffy <raffy at mac.com>
• Date: Fri, 16 Oct 2009 07:19:04 -0400 (EDT)
• References: <ha4r9k\$d0h\$1@smc.vnet.net>

```On Oct 2, 5:22 am, David Bevan <david.be... at pb.com> wrote:
> I'm new to Mathematica, so if I've missed something obvious, my apologies.
>
> I want a function to generate a list of "submultisets" with up to k elements of a set s, allowing elements from s to be repeated.
>
> The following works, but is very inefficient since each multiset is generated multiple times and then sorted and then repeats deleted:
>
> coinSets[s_,k_]:=DeleteDuplicates[Sort/@Flatten[Tuples[s,#]&/@Range[k],1]]
>
> coinSets[{1,3,4},3]
>
> {{1},{3},{4},{1,1},{1,3},{1,4},{3,3},{3,4},{4,4},{1,1,1},{1,1,3},{1,1,4},{1 ,3,3},{1,3,4},{1,4,4},{3,3,3},{3,3,4},{3,4,4},{4,4,4}}
>
> I assumed there would be a suitable function in the Combinatorica package, but I can't see anything -- which would be a bit odd for a combinatorial package. What have I missed?
>
> Do I need to write my own (perhaps by looking at how KSubsets is implemented) or is there some easy way of generating these multisets?
>
> Thanks.
>
> David %^>

[I posted this yesterday but Google Groups is acting odd and placed my

Another way of looking at the "coin sets" is thinking about it in
terms of how each set combination is generated.

naive[k_, n_] := Union[Ceiling[#/n] & /@ Subsets[Range[k*n], {1, n}]];

naive[3, 3] = {{1}, {2}, {3}, {1, 1}, {1, 2}, {1, 3}, {2, 2}, {2, 3},
{3, 3}, {1, 1, 1}, {1, 1, 2}, {1, 1, 3}, {1, 2, 2}, {1, 2, 3}, {1, 3,
3}, {2, 2, 2}, {2, 2, 3}, {2, 3, 3}, {3, 3, 3}}

This set of sets can be analyzed by asking: for each set, how many 1's
are there, how many 2's, etc...

recipe[k_, n_] := Table[Count[v, i], {v, naive[k, n]}, {i, k}];

recipe[3, 3] = {{1, 0, 0}, {0, 1, 0}, {0, 0, 1}, {2, 0, 0}, {1, 1, 0},
{1, 0, 1}, {0, 2, 0}, {0, 1, 1}, {0, 0, 2}, {3, 0, 0}, {2, 1, 0}, {2,
0, 1}, {1, 2, 0}, {1, 1, 1}, {1, 0, 2}, {0, 3, 0}, {0, 2, 1}, {0, 1,
2}, {0, 0, 3}}

For example:

set 	  => recipe
{1}       => {1, 0, 0} 	"a list with 1x1"
{1, 1}    => {2, 0, 0} 	"a list with 2x1"
{2, 3, 3} => {0, 1, 2}  "a list with 1x2 + 2x3"

If you take the element-sorted union of these recipes, you'll see a
pattern:

basis[k_, n_] := Union[Sort /@ recipe[k, n]]

basis[3, 3] = {{0, 0, 1}, {0, 0, 2}, {0, 0, 3}, {0, 1, 1}, {0, 1, 2},
{1, 1, 1}}

You can reverse this operation by performing:

recipe[3, 3] === Join @@ (Permutations /@ basis[3, 3])
(note they might have different sortings)

So the process to generate all the coin sets is the following:

1. We need a function that generates the "basis" from above, given k
and n:

basis[len_, sum_] :=
Do[#0[Append[#1, i], i, #3 - i], {i, #2, #3}]] &[{}, 1,
sum], {n, len}]][[2, 1]];

basis[3, 3] = {{1, 0, 0}, {2, 0, 0}, {3, 0, 0}, {1, 1, 0}, {1, 2, 0},
{1, 1, 1}}

2. We need to permutate each basis to generate all the recipes for
that combination.

recipes[k_, n_] := Join @@ Table[Permutations[Developer`ToPackedArray
[v]], {v, basis[k, n]}];

3. At this stage, we have our answer as a list of recipes, where each
recipe is a vector of length k, whose sum is between 1 and n, can be
converted into a coin set by using it as a recipe (see above).

{0, 1, 0} => 1x2             => {2}
{3, 0, 0} => 3x1             => {1, 1, 1}
{1, 1, 1} => 1x1 + 1x2 + 1x3 => {1, 2, 3}

Timing[Length[recipes[15, 12]]] => {4.62615, 17383859}
Timing[Length[recipes[15, 10]]] => {0.841442, 3268759}
Timing[Length[recipes[15, 7]]]  => {0.052076, 170543}

Another advantage of the recipe form is it makes Intersect/Union/
Complement/MemberQ/FreeQ fast to implement.

```

• Prev by Date: Re: Mathematica 7.01 and Mac OS 10.6 (Snow Leopard)
• Next by Date: Re: Mathematica 7.01 and Mac OS 10.6
• Previous by thread: Re: generating submultisets with repeated elements
• Next by thread: "Freezing" an Output cell?