5
$\begingroup$

Imagine I have a list of integers $l=\{l_1,l_2,...,l_{50}\}$, say, for example

l = RandomInteger[10, 50]

and I want to find how many ways there are of summing numbers from that list such that the sum is a given number $K$. In other words, I'm looking for all the possible combinations of coefficients $\{x_1,...,x_{50}\}$ such that $$ \sum_{i=1}^{50} x_i l_i=K $$ where $x_i\in\{0,1\}$. I suppose this could be a very demanding calculation, but I wonder if there is a good or efficient way of finding these combinations and listing them.

$\endgroup$
6
$\begingroup$

One idea is to use BooleanCountingFunction and SatisfiabilityInstances. First, a helper function that creates a list of n variables and a boolean expression asserting that all or none of the variables are true (in other words, each member k of your list is represented by k boolean variables):

g[n_] := With[{v = Table[Unique[], n]},
    {v, BooleanCountingFunction[{{0, n}}, n] @@ v}
]

This helper function is mapped over each element of your list. Then, a BooleanCountingFunction is created that is true when the target number of variables are true. Finally, SatisfiabilityInstances is used to find variables that satisfy the individual boolean expressions and the BooleanCountingFunction. Here's some code that finds the counts and the instances:

counts[v_, t_] := Module[{vv=g/@v, len, var, bool, i},
    var = Flatten[vv[[All, 1]]];
    len = Length @ var;
    bool = BooleanCountingFunction[{t}, len] @@ var && And @@ vv[[All, 2]];
    SatisfiabilityCount[bool, var]
]

instances[v_, t_] := Module[{vv=g/@v, len, var, bool, i},
    var = Flatten[vv[[All, 1]]];
    len = Length @ var;
    bool = BooleanCountingFunction[{t}, len] @@ var && And @@ vv[[All, 2]];
    i = Thread[var->#]& /@ SatisfiabilityInstances[bool, var, All];
    Boole[vv[[All, 1, 1]] /. i]
]

Example:

SeedRandom[1];
l = RandomInteger[{1, 10}, 50];

counts[l, 10] //AbsoluteTiming
res = instances[l, 10]; //AbsoluteTiming

{0.010638, 70934}

{28.4981, Null}

Check:

Tally[res . l]

{{10, 70934}}

Finding the instances is unfortunately rather slow.

$\endgroup$
3
  • $\begingroup$ Thanks for this answer. The functions you use are unfamiliar to me, and your example helps me understand them. Can you tell me why the result res always has nine 1 and the rest 0? How would you find the case with two 1, for example {1,0,0,1,0,0,...,0}? $\endgroup$ Nov 8 '20 at 15:45
  • $\begingroup$ @KennyColnago Thanks, I had a bug in the definition of g, and fixing this bug means that the instances code is quite a bit slower. $\endgroup$
    – Carl Woll
    Nov 8 '20 at 16:33
  • $\begingroup$ This seems fantastic Carl, I will take a careful look and try to implement it in my code :) $\endgroup$
    – sam wolfe
    Nov 8 '20 at 23:37
5
$\begingroup$
Clear["Global`*"]

f[list_ /; Length[list] > 0, k_Integer?Positive] := Module[{x, var},
  var = Array[x, Length[list]];
  var /. Solve[{list.var == k, 0 <= var <= 1} // Flatten, var, Integers]]

SeedRandom[1]

list = RandomInteger[{1, 10}, 50]

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

k = 10;

sol = f[list, k];

Verifying the solutions,

And @@ (#.list == k & /@ sol)

(* True *)

There are too many solutions to look at

Length@sol

(* 70934 *)

Looking at the non-zero entries of the first ten solutions along with the corresponding list elements

(Transpose[{list, #}] & /@ sol[[1 ;; 10]]) /. {_, 0} :> Nothing

(* {{{5, 1}, {2, 1}, {3, 1}}, {{5, 1}, {2, 1}, {3, 1}}, {{5, 1}, {5, 1}}, {{1, 
   1}, {6, 1}, {3, 1}}, {{2, 1}, {2, 1}, {6, 1}}, {{2, 1}, {5, 1}, {3, 
   1}}, {{2, 1}, {5, 1}, {3, 1}}, {{2, 1}, {1, 1}, {5, 1}, {2, 1}}, {{2, 
   1}, {1, 1}, {5, 1}, {2, 1}}, {{10, 1}}} *)
$\endgroup$

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.