7

I need a function that creates a table of all possible lists of length $n$ which contain integer entries that sum up to the same given number $m$. For example, if we consider lists of size $n=3$ and want to distribute the number $m=2$ in them the result should be:

n=3;
m=2;
numberDistribute[n,m]

{{2,0,0},{0,2,0},{0,0,2},{1,1,0},{1,0,1},{0,1,1}}

Is there such a function in Mathematica? Or maybe there is a convenient way to write it? Thanks for any suggestion.

Kagaratsch
  • 11,955
  • 4
  • 25
  • 72

4 Answers4

8

Proposition

The built-in function IntegerPartitions can be useful here.

numberDistribute[n_, m_] := 
   Join @@ (Permutations /@ (PadLeft[#, n] & /@ IntegerPartitions[m, n]))

Update

To avoid mapping twice through the list generated by IntegerPartitions:

numberDistribute2[n_, m_] := 
   Join @@ ((Permutations@PadLeft[#, n]) & /@ IntegerPartitions[m, n])
  • Much faster than the other solutions, +1 – eldo Dec 03 '15 at 02:50
  • This also avoids the memory problems introduced by creating large tuples. This is a great solution - I had no idea that IntegerPartitions existed! – djphd Dec 03 '15 at 03:36
  • 2
    To avoid having to Pad, do Join @@ Permutations /@ IntegerPartitions[m, {n}, Range[0, m]]. – march Dec 03 '15 at 04:20
  • @march Thanks for mentioning, this is indeed nicer. –  Dec 03 '15 at 04:32
3

Of the solutions so far, those based on IntegerPartitions by @Xavier and @march are orders of magnitude faster than those based on Tuples (@djphd and @eldo). Just for interest, the following method based on FrobeniusSolve is about 10 times faster than Tuples, but still much slower than IntegerPartitions.

AnotherNumberDistribute[n_,m_]:=FrobeniusSolve[ConstantArray[1, n], m]
KennyColnago
  • 15,209
  • 26
  • 62
2

How about

numberDistribute[n_?IntegerQ, m_?IntegerQ] :=
   Select[Tuples[Range[0, m], n], Total[#] == m &]
march
  • 23,399
  • 2
  • 44
  • 100
djphd
  • 362
  • 2
  • 10
1
numberDistribute[n_, m_] :=
 Cases[Tuples[Range[0, n - 1], n], a_List /; Total@a == m]

numberDistribute[3, 2]

{{0, 0, 2}, {0, 1, 1}, {0, 2, 0}, {1, 0, 1}, {1, 1, 0}, {2, 0, 0}}

Or

m = 2;
n = 3;

Pick[#, Plus @@@ # - m, 0] &[Tuples[Range[0, m], n]]

{{0, 0, 2}, {0, 1, 1}, {0, 2, 0}, {1, 0, 1}, {1, 1, 0}, {2, 0, 0}}

eldo
  • 67,911
  • 5
  • 60
  • 168
  • For some reason the produced entries are never bigger than n-1, so this implementation misses some combinations for larger examples. – Kagaratsch Dec 03 '15 at 02:21
  • Except the ordering my result seems to be the result of your question – eldo Dec 03 '15 at 02:26
  • Oh, the ordering does not really matter. But I found how to fix your code: Cases[Tuples[Range[0, m], n], a_List /; Total@a == m] seems to work great! – Kagaratsch Dec 03 '15 at 02:27