# More general permutation of lists

For some arbitrary $$N$$, I would like to construct all permutations of lists of length $$n \leq N$$ such that the sum of each permutation list adds to a value less than or equal to $$N$$.

Specifically, for $$N = 3$$ and $$n = 3$$, I want to generate these lists:

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


As you can see this is more general than using Permutations[Range[3]].

• Your list does not contain e.g. {1,1,1}. Is that correct? – AccidentalFourierTransform Jul 2 at 15:11
• @AccidentalFourierTransform, well spotted, I'll edit the question thanks – Sid Jul 2 at 15:12

Flatten[Map[Permutations, PadRight[#, 3] & /@ IntegerPartitions[#, 3] & /@ Range[3], {-2}], 2]

• Was just about to post the same thing! You win :D – swish Jul 2 at 15:23
• This is neat, but does it only work $N=n$? How can it be generalised? – Sid Jul 2 at 15:38
• Just susbtitute one of the 3 for N, and the other one for n, (BTW, next time it is easier if you use two different values for N,n instead of N=n=3). – AccidentalFourierTransform Jul 2 at 15:41

Several alternative approaches using (1) FrobeniusSolve, (2) Tuples, (3) Outer, and (4) IntegerPartitions:

ClearAll[f1, f2, f3 , f4, f5]
f1[n_, m_] := Join @@ (FrobeniusSolve[ConstantArray[1, m], #] & /@ Range[0, n])
f2[n_, m_] := If[Total @ # <= n, #, ## &[]] & /@ Tuples[Range[0, n], {m}]
f3[n_, m_] := Flatten[Outer[If[+## <= n, {##}, ## &[]] &, ## & @@
ConstantArray[Range[0, n], m]], 2]
f4[n_, m_] := Join @@ (Permutations /@ PadRight[Join @@
(IntegerPartitions[#, m] & /@ Range[0, n])])
f5[n_, m_] := Join @@ (Permutations /@ (Join @@ (IntegerPartitions[#, {m},
Range[0, n]] & /@ Range[0, n])))

Sort@f1[3, 3] == Sort@f2[3, 3] == Sort@f3[3, 3] == Sort@f4[3, 3] == Sort@f5[3, 3]


True

f1[3, 3]


{{0, 0, 0}, {0, 0, 1}, {0, 1, 0}, {1, 0, 0}, {0, 0, 2}, {0, 1, 1}, {0, 2, 0}, {1, 0, 1}, {1, 1, 0}, {2, 0, 0}, {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}}

f1[4, 2]


{{0, 0}, {0, 1}, {1, 0}, {0, 2}, {1, 1}, {2, 0}, {0, 3}, {1, 2}, {2, 1}, {3, 0}, {0, 4}, {1, 3}, {2, 2}, {3, 1}, {4, 0}}

Here's a pretty straightforward way: build all the possible vectors, check if the sum of their elements is <=3. The Flatten and Select remove the ones that don't match.

Select[Flatten[Table[If[i + j + k <= 3, {i, j, k}], {i, 0, 3}, {j, 0, 3},
{k, 0, 3}], 2], # =!= Null &]

• How can this be generalised for arbitrary $N$ and $n$? – Sid Jul 2 at 15:20