Re: combinatorics problem

*To*: mathgroup at smc.vnet.net*Subject*: [mg40104] Re: [mg40087] combinatorics problem*From*: Dr Bob <drbob at bigfoot.com>*Date*: Thu, 20 Mar 2003 03:34:52 -0500 (EST)*References*: <200303190823.DAA28940@smc.vnet.net>*Reply-to*: drbob at bigfoot.com*Sender*: owner-wri-mathgroup at wolfram.com

This gets you a step or two farther: << DiscreteMath`Combinatorica`; ClearAll[combinations]; combinations::usage = "combinations[list,n:{__Integer}] lists the \ combinations of list taken n at a time"; combinations[r_List, n_Integer, {}] := Which[n > Length@r, {}, n == Length@r, \ r, True, DiscreteMath`Combinatorica`KSubsets[r, n]]; combinations[r_List, n_Integer, e_?VectorQ] := Join[e, #] & /@ \ DiscreteMath`Combinatorica`KSubsets[Complement[r, e], n]; combinations[r_List, n_Integer, e : {__?VectorQ}] := Flatten[combinations[ r, n, #] & /@ e, 1]; combinations[r_List, {n_Integer}] := combinations[r, n, {}]; combinations[r_List, n : {__Integer}] := Which[Plus @@ n == Length@r, Join[#, Complement[r, #]] & /@ combinations[r, Drop[ n, -1]], Plus @@ n > Length@r, {}, True, Fold[combinations[r, #2, #1] &, {}, n]] ClearAll@splitter splitter[n : {__Integer}] := Range @@@ Transpose@{Drop[FoldList[Plus, 1, p], -1], Rest@FoldList[Plus, 0, p]} combo[a_List, n : {__Integer}] := Transpose[combinations[a, n][[All, #]] & /@ splitter@n] listA = {1, 2, 3, 4, 5}; p = {2, 2, 1}; combo[listA, p] Bobby On Wed, 19 Mar 2003 03:23:24 -0500 (EST), Szumiloski, John <john_szumiloski at merck.com> wrote: > Dear MathGroupers, > > (I use both v4.2 for WinNT 4 w/ 512MB RAM, and v4.0.1 for MacOS 8.6 w/ > 160 > MB RAM.) > > I am trying to write a function which takes a list 'listA' of n integers > (perhaps nondistinct) and an arbitrary integer partition 'P' of n, and, > for > the list of all the ways to partition the elements of listA into sublists > of > the sizes given by P, sums each sublist for each instance and returns the > number of times each distinct set of sums (where the order is not > important) > occurs. (Apologies for using 'partition' in two different ways here) > > This is complicated, so an example definitely helps. Let's break the > problem up. Say the function prelimfunc returns a list of all the ways > to > partition the elements of listA into sublists of the sizes given by P: > > In[1]:= listA = {1,2,3,4,5} ; P = {2,2,1}; (* Note Length[listA] = > Apply[Plus,P] *) > > In[2]:= pre1=prelimfunc[listA, P] Out[2]= { {{1,2},{3,4},{5}}, > {{1,2},{3,5},{4}}, {{1,2},{4,5},{3}}, {{1,3},{2,4},{5}}, > {{1,3},{2,5},{4}}, {{1,3},{4,5},{2}}, {{1,4},{2,3},{5}}, > {{1,4},{2,5},{3}}, {{1,4},{3,5},{2}}, {{1,5},{2,3},{4}}, > {{1,5},{2,4},{3}}, {{1,5},{3,4},{2}}, {{2,3},{4,5},{1}}, > {{2,4},{3,5},{1}}, {{2,5},{3,4},{1}} } > > Desired properties of prelimfunc: > 1) The order of the returned list is not important; the example's order > was > just an artifact of my enumerating the result in my head. > 2) The ordering of the sublists are not important. Thus, > {{1,2},{3,4},{5}} > would be considered the same list as {{3,4},{1,2},{5}}, so only one would > appear in the result. 3) The ordering of the elements within each > sublist are not important. > Thus, {{1,2},{3,4},{5}} would be considered the same list as > {{2,1},{3,4},{5}}, so only one would appear in the result. 4) Replicates > of the elements of listA are considered distinct. This, if > listA={1,2,3,1,5} (where there are two elements equal to 1), there would > be > two lists of {{1,3},{1,5},{2}} in the result, corresponding to the 6th > and > 12th list element in the above output. Since there are two "1"s in this > listA, this result would not violate property (2) above, since the "1"s > are > considered distinct. Thus the result will always contain the same number > of > possible partitions of listA so long as listA has same length n and the > integer partition of n remains the same. > > The next operation would be, for each element in this list, to sum up > each > sublist: > > In[3]:= pre2=Map[Apply[Plus, #]&, pre1, {2}] > Out[3]= { {3, 7, 5}, {3, 8, 4}, {3, 9, 3}, {4, 6, 5}, {4, 7, 4}, {4, 9, > 2}, {5, 5, 5}, {5, 7, 3}, {5, 8, 2}, {6, 5, 4}, {6, 6, 3}, {6, 7, 2}, {5, > 9, 1}, {6, 8, 1}, {7, 7, 1} } > > Next, determine the distinct set of sums: > > In[4]:= pre3=Union[Map[Sort, pre2] ] > Out[4]= { {1, 5, 9}, {1, 6, 8}, {1, 7, 7}, {2, 4, 9}, {2, 5, 8}, {2, 6, > 7}, {3, 3, 9}, {3, 4, 8}, {3, 5, 7}, {3, 6, 6}, {4, 4, 7}, {4, 5, 6}, {5, > 5, 5} } > > Next, for each of these sets, count how many times each appears in the > previous result (order not being important): > > In[5]:= pre4=Map[Count[#, True]&, Outer[SameQ, pre3, Map[Sort, pre2], 1] > ] > Out[5]= {1, 1, 1, 1, 1, 1, 1, 1, 2, 1, 1, 2, 1} > > Last, return the unique sets of sums with the number of times each > appears: > > In[6]:= Thread[List[pre3, pre4] ] (* for example *) > Out[6]= { {{1, 5, 9}, 1}, {{1, 6, 8}, 1}, {{1, 7, 7}, 1}, {{2, 4, 9}, 1}, > {{2, 5, 8}, 1}, {{2, 6, 7}, 1}, {{3, 3, 9}, 1}, {{3, 4, 8}, > 1}, > {{3, 5, 7}, 2}, {{3, 6, 6}, 1}, {{4, 4, 7}, 1}, {{4, 5, 6}, > 2}, {{5, 5, 5}, 1} } > > So I want a function myfunc which would do this: > > In[7]:= myfunc[listA, P] > Out[7]= { {{1, 5, 9}, 1}, {{1, 6, 8}, 1}, {{1, 7, 7}, 1}, {{2, 4, 9}, 1}, > {{2, 5, 8}, 1}, {{2, 6, 7}, 1}, {{3, 3, 9}, 1}, {{3, 4, 8}, > 1}, > {{3, 5, 7}, 2}, {{3, 6, 6}, 1}, {{4, 4, 7}, 1}, {{4, 5, 6}, > 2}, {{5, 5, 5}, 1} } > > Another example, with more multiplicities: > > In[8]:= myfunc[{1,1,2,2,3}, {2,2,1}] > Out[8]= { {{1, 3, 5}, 4}, {{1, 4, 4}, 2}, {{2, 2, 5}, 2}, > {{2, 3, 4}, 5}, {{3, 3, 3}, 2} } > > I have figured out how to write a naive version of prelimfunc by 1) > simply > enumerating all permutations of listA, 2) pruning (if P has some repeated > elements; accounts for property (2) above), 3) inserting braces in the > appropriate places. So with the additional steps above given explicitly, > in > a sense I have solved my problem. > > > ****However****, I would like a solution which does not have intermediate > steps that consume memory (and time?) at an (supra-?)exponential rate. I > am > interested in using listA of 30-40 elements or maybe more (!). > > One approach could be to enumerate the distinct set of sums (e.g., pre3) > first, then determine how many times each would appear. I have written > this > function which enumerates the possible sum sets, based loosely on the > Partitions code in the Combinatorica package: > > (******** Begin code ********) > NonZeroCompositions[totalsum_Integer /; totalsum <= 1, ___] := {}; > NonZeroCompositions[totalsum_Integer, ngroups_Integer /; ngroups < 1, > ___] > := {}; > NonZeroCompositions[totalsum_Integer, 1, ___ ] := {{totalsum}}; > NonZeroCompositions[totalsum_Integer, ngroups_Integer, ___] /; (ngroups > > totalsum) := {}; > NonZeroCompositions[totalsum_Integer, ngroups_Integer] := > NonZeroCompositions[totalsum, ngroups] = NonZeroCompositions[totalsum, > ngroups, 1]; > NonZeroCompositions[totalsum_Integer, ngroups_Integer, low_Integer] /; > (low * ngroups > totalsum) > := {}; > (* ...and the workhorse... *) > NonZeroCompositions[totalsum_Integer, ngroups_Integer, low_Integer] := > Partition[Flatten[Table[Map[Append[{i}, #] &, > NonZeroCompositions[totalsum - > i, ngroups - 1, i]], > {i, low, Floor[totalsum/ngroups]} > ] > ], ngroups]; > (******** End code ********) > > The argument totalsum refers to the sum of the elements of listA (so the > sum > over each set in the result is also this), and ngroups to the number of > elements in the partition P. Thus to get the candidate sum sets for the > example, we do > > In[8]:= sets=NonZeroCompositions[Apply[Plus, listA] (* = 15 *), Length[P] > (* > = 3 *) ] > Out[8]= { {1, 1, 13}, {1, 2, 12}, {1, 3, 11}, {1, 4, 10}, {1, 5, 9}, {1, > 6, > 8}, {1, 7, 7}, {2, 2, 11}, {2, 3, 10}, {2, 4, 9}, {2, 5, 8}, {2, > 6, 7}, {3, 3, 9}, {3, 4, 8}, {3, 5, 7}, {3, 6, 6}, {4, 4, 7}, {4, 5, > 6}, {5, 5, 5} } > > Now some of these do not appear in pre3 (e.g., {1,1,13}); without loss of > generality I would have my function not include such sum sets in the > final > result. > > > Given 'listA', 'P', and now 'sets', I suspect I can Map 'sets' into a > function of listA and P which counts the number of times each sum set > would > appear, **without** actually enumerating all the partitions, summing > etc., > etc. I strongly suspect this can be done using Backtrack from the > Combinatorica package. But this is now getting beyond my level of > Mathematica competence. > > Any assistance would be most welcome; suggestions of course do not have > to > utilize my NonZeroCompositions function, although I suspect it would be > useful. If I get more than one approach, I may summarize some > performance > benchmarks for the group. > > Thanks in advance for any insights. > > John > > -------------------------------------------------------------------------- > > > ---- > Notice: This e-mail message, together with any attachments, contains > information of Merck & Co., Inc. (Whitehouse Station, New Jersey, USA) > that may be confidential, proprietary copyrighted and/or legally > privileged, and is intended solely for the use of the individual or > entity named on this message. If you are not the intended recipient, and > have received this message in error, please immediately return this by e- > mail and then delete it. > > ============================================================================== > > > -- majort at cox-internet.com Bobby R. Treat

**References**:**combinatorics problem***From:*"Szumiloski, John" <john_szumiloski@merck.com>

**Re: combinatorics problem**

**Re: combinatorics problem**

**Re: combinatorics problem**

**Re: combinatorics problem**