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 reply in a different thread.] Another way of looking at the "coin sets" is thinking about it in terms of how each set combination is generated. I'll start with a naive solution: 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_] := Reap[Do[If[Length[#1] == n, Sow[PadRight[#1, len]], 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.