2
$\begingroup$

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.

Improve this question
$\endgroup$
6
  • 1
    $\begingroup$ You can use Select, eg Select[ IntegerPartitions[35, {4}, Range[0, 12]] , Length@Union@# == 4 & ] $\endgroup$
    – george2079
    Mar 7, 2017 at 18:21
  • 1
    $\begingroup$ @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. $\endgroup$
    – kirma
    Mar 7, 2017 at 18:52
  • 2
    $\begingroup$ @george2079 Even better and what I originally sought is DuplicateFreeQ. $\endgroup$
    – kirma
    Mar 7, 2017 at 19:07
  • 1
    $\begingroup$ Brute force one-liner Select[Subsets[yourList,{subsetLength}],Total@#==sum&] e.g. Select[Subsets[Range[10],{4}],Total@#==25&] $\endgroup$
    – N.J.Evans
    Mar 7, 2017 at 19:35
  • 3
    $\begingroup$ 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. $\endgroup$
    – Daniel Lichtblau
    Mar 7, 2017 at 20:37

2 Answers 2

Reset to default
9
$\begingroup$

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

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

(* Out[98]= {{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}} *)
Improve this answer
$\endgroup$
1
  • $\begingroup$ Somewhat more ghastly: In[255]:= 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[256]= {{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}} $\endgroup$
    – Daniel Lichtblau
    Mar 8, 2017 at 0:48
3
$\begingroup$

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[1], v[2]... (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).

Improve this answer
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

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