# Integer partitions without repetitions

What combination of numbers makes a specific sum?

The code below is not very effective, because it also gives answers in which a number is used more than once even though it was given in the list only once.

IntegerPartitions[45, {4}, {1, 2, 3, 4, 5, 6, 7, 8, 9, 10}]


{{10, 10, 10, 5}, {10, 10, 9, 6}, {10, 10, 8, 7}, {10, 9, 9, 7}, {10, 9, 8, 8}, {9, 9, 9, 8}}

Notice that $10$ is given just once as a number in the last argument of IntegerPartitions, yet it appears three times in the first answer, and twice in the second; likewise with $9$.

So how can Mathematica be coded to return answers that have unique elements?

P.S I know FrobeniusSolve does not work as it only returns how many times numbers/(elements of answers) appear in a specific answer.

• You can use Select, eg Select[ IntegerPartitions[35, {4}, Range[0, 12]] , Length@Union@# == 4 & ] Mar 7, 2017 at 18:21
• @george2079 You can use plain Apply@Greater instead of Length@Union@# == 4 & for this filtering approach, but this works just because these results have a descending order. Mar 7, 2017 at 18:52
• @george2079 Even better and what I originally sought is DuplicateFreeQ. Mar 7, 2017 at 19:07
• Brute force one-liner Select[Subsets[yourList,{subsetLength}],Total@#==sum&] e.g. Select[Subsets[Range,{4}],Total@#==25&] Mar 7, 2017 at 19:35
• IntegerPartitions[45, {4}, {1, 2, 3, 4, 5, 6, 7, 8, 9, 10}] gives {}. It pays to post correctly functioning code, else it is just confusing. Mar 7, 2017 at 20:37

Could set this up as a 1-0 integer linear programming problem.

Module[{vars = Array[a, 10]},
vars*Range /.
Solve[Flatten@{vars.Range == 28, Total[vars] == 4,
Map[0 <= # <= 1 &, vars]}, vars, Integers] /. 0 -> Nothing]

(* Out= {{5, 6, 8, 9}, {5, 6, 7, 10}, {4, 7, 8, 9}, {4, 6, 8,
10}, {4, 5, 9, 10}, {3, 7, 8, 10}, {3, 6, 9, 10}, {2, 7, 9, 10}, {1,
8, 9, 10}} *)

• Somewhat more ghastly: In:= sum = Sum[a[j]*x^j, {j, 1, 10}]; Apply[List, Coefficient[ Nest[Expand[sum*#] /. {a[x_]^2 :> 0, x^j_ /; j > 28 :> 0} &, sum, 3], x^28]] /. ii_Integer*(x : Repeated[a[_], {4}]) :> {x} /. a[j_] :> j Out= {{5, 6, 8, 9}, {4, 7, 8, 9}, {5, 6, 7, 10}, {4, 6, 8, 10}, {3, 7, 8, 10}, {4, 5, 9, 10}, {3, 6, 9, 10}, {2, 7, 9, 10}, {1, 8, 9, 10}} Mar 8, 2017 at 0:48

Finding sums of unique integers out of alternatives, with count of them picked, summing up to sum:

Function[{sum, count, alternatives},
With[{vars = Array[v, count]},
vars /. Solve[
Total@vars == sum && Greater @@ vars &&
And @@ Table[
Or @@ Table[var == alt, {alt, alternatives}], {var, vars}],
vars]]][25, 4, {1, 2, 3, 4, 5, 6, 7, 8, 9, 10}]

(* {{8, 7, 6, 4}, {9, 7, 5, 4}, {9, 7, 6, 3}, {9, 8, 5, 3}, {9, 8, 6, 2},
{9, 8, 7, 1}, {10, 6, 5, 4}, {10, 7, 5, 3}, {10, 7, 6, 2}, {10, 8, 4, 3},
{10, 8, 5, 2}, {10, 8, 6, 1}, {10, 9, 4, 2}, {10, 9, 5, 1}} *)


The approach here is to use variables v, v... (count in total) in Solve and constrain solutions in a following manner:

• variables sum up to sum,
• they are in decreasing order which implies non-equality, and
• each of them has value equal to one of alternatives listed.

This is not really particularly efficient implementation, but it does the job in smaller cases.

If you can limit the range of solutions to something like integers in a specific range, you can also simplify and speed up the problem considerably:

Function[{sum, count, min, max},
With[{vars = Array[v, count]},
vars /. Solve[
Total@vars == sum && Greater @@ vars &&
And @@ Table[min <= var <= max, {var, vars}], vars,
Integers]]][25, 4, 1, 10]


The result is the same.

It would also be possible to apply discrete LinearProgramming to the problem, but this would provide just one instance of a solution (likewise to FindInstance instead of Solve).