Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

Let $a\in\mathbb{N}^n$ and $k\in\mathbb{N}\!=\!\{0,1,2,\ldots\}$. How can I efficiently generate the list $$\{(a_1,\ldots,a_k); a_1,\ldots,a_k\!\in\!\mathbb{N}^n\!\setminus\!\{0\}, a_1\!+\!\ldots\!+\!a_k\!=\!a\}?$$

It would also be desirable for the code to be short. My current, highly inefficient solution is:

Select[Tuples[Tuples[Range[0, Max @@ a], Length@a], k], 
  Plus @@ # == a && !MemberQ[#, Table[0, {i, n}]]&]
share|improve this question
    
If there were a function that would produce all ordered partitions of length $k$ (containing zeros) of a given $x\in\mathbb{N}$, then taking tuples would solve the problem. –  Leon Mar 23 at 3:10
    
Look at IntegerPartitions... –  rasher Mar 23 at 3:31
    
Or better yet, Needs["Combinatorica`"] Compositions[5,3]. –  Leon Mar 23 at 3:36
    
Just be aware of compatibility issues if you're on recent version of Mathematica, some posts here cover such, and docs has guide.... –  rasher Mar 23 at 3:41

2 Answers 2

up vote 0 down vote accepted

The answer I was looking for, using Needs["Combinatorica`"], is:

a={2,2,1}; n=Length@a; k=3;

Select[Transpose/@Tuples[Table[Compositions[a[[i]],k],{i,n}]], !MemberQ[#,Table[0,{i,n}]]&]

If furthermore all tuples with at least one vector without a $0$ entry are removed, then:

complex = Table[Select[Transpose/@Tuples[Table[Compositions[a[[i]],k],{i,n}]], !MemberQ[#,Table[0,{i,n}]] && (And@@(MemberQ[#,0]&/@#))&],{k,deg}]; Column/@complex

share|improve this answer

Let's start by defining a helper function that will find all of the partitions of an integer that contains exactly k components:

partitions[n_, k_] :=
  Composition[Union, Permutations, PadRight[#, k]&] /@ IntegerPartitions[n, k] //
  Flatten[#, 1]& //
  Sort

We let IntegerPartitions do the heavy-lifting, but pad the results with zeroes so that there are always exactly k components. We permute each of the results and eliminate duplicates. Flatten is used to undo the extra list level introduced by Permutations. Finally, we Sort the result to impose a canonical order (this step is optional).

Here it is in action:

partitions[3, 3]
(*{{0,0,3},{0,1,2},{0,2,1},{0,3,0},{1,0,2},{1,1,1},{1,2,0},{2,0,1},{2,1,0},{3,0,0}}*)

We then use this helper function to define the main function:

setPartitions[a_, k_] :=
  Module[{n = Length@a, z = 0 a}
  , partitions[#, k]& /@ a //
    Tuples //
    Transpose[#, {1, 3, 2}]& //
    Select[#, FreeQ[#, z]&]&
  ]

This invokes the helper function on each element of a. All possible combinations of the individual element partitions are then assembled using Tuples. Transpose generates the result vector sets. Finally, any combination involving the zero vector is removed.

Sample use:

setPartitions[{1, 2}, 2]
(*{{{0, 1}, {1, 1}}, {{0, 2}, {1, 0}}, {{1, 0}, {0, 2}}, {{1, 1}, {0, 1}}}*)

setPartitions[{3, 5, 7}, 2] generates the same 190 sets as the code exhibited in the question applied to the same parameters. On my machine, the original code took 1.89s to run whereas setPartitions was too fast to measure (0s reported). Notwithstanding this improvement, beware that this problem generates very large solution sets for even small increases in magnitude of k, n or the individual a[[i]]. For example, setPartitions[{3, 5, 7}, 5] took 9.08s to generate 856,985 solutions.

Edit

At the suggestion of @rasher, partitions can be expressed more concisely thus:

partitions[n_, k_] :=
    Join @@ (Permutations /@ IntegerPartitions[n, {k}, Range[0, n]]) // Sort

Once again, the Sort is optional and is only there to obtain the same order of results as the code in the question. I would recommend removing the Sort if that order is not crucial.

share|improve this answer
    
Nice, but "helper" is doing much more work than needed, try e.g. this, order of magnitude faster on smallish, faster yet as results size increases: fastComp[n_, k_] := Join @@ (Permutations /@ IntegerPartitions[n, {k}, Range[0, n]]) –  rasher Mar 23 at 6:57
    
@rasher Much nicer, thanks. I have incorporated your suggestion as an addendum. For setPartitions[{3, 5, 7}, 5], the main function still dominates the run time as the helper optimization only shaved off about 0.12s off total time on my machine. –  WReach Mar 23 at 14:00
    
I have another question: How can I remove from this list all tuples of vectors $(a_1,\ldots,a_k)$, where at least one $a_i$ is componentwise $\geq(1,\ldots,1)$? –  Leon Mar 24 at 2:03
    
The filtering is done in the call to FreeQ. We could add another pattern, e.g. FreeQ[#, z|u]&, where u = z + 1. –  WReach Mar 24 at 3:55

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

Not the answer you're looking for? Browse other questions tagged or ask your own question.