0
$\begingroup$

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]].

|improve this question
$\endgroup$
  • $\begingroup$ Your list does not contain e.g. {1,1,1}. Is that correct? $\endgroup$ – AccidentalFourierTransform Jul 2 at 15:11
  • $\begingroup$ @AccidentalFourierTransform, well spotted, I'll edit the question thanks $\endgroup$ – Sid Jul 2 at 15:12
5
$\begingroup$ 
Flatten[Map[Permutations, PadRight[#, 3] & /@ IntegerPartitions[#, 3] & /@ Range[3], {-2}], 2]
|improve this answer
$\endgroup$
  • 1
    $\begingroup$ Was just about to post the same thing! You win :D $\endgroup$ – swish Jul 2 at 15:23
  • $\begingroup$ This is neat, but does it only work $N=n$? How can it be generalised? $\endgroup$ – Sid Jul 2 at 15:38
  • $\begingroup$ 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). $\endgroup$ – AccidentalFourierTransform Jul 2 at 15:41
5
$\begingroup$

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}}

|improve this answer
$\endgroup$
2
$\begingroup$

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 &]
|improve this answer
$\endgroup$
  • $\begingroup$ How can this be generalised for arbitrary $N$ and $n$? $\endgroup$ – Sid Jul 2 at 15:20

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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