Summing over Partitions

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.

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

• 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}? Nov 8 '20 at 15:45
• @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. Nov 8 '20 at 16:33
• This seems fantastic Carl, I will take a careful look and try to implement it in my code :) Nov 8 '20 at 23:37
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

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