Summing over Partitions

Question

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.

Answer 1

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.

Answer 2

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