Subset sum problem: Difference between revisions

From Rosetta Code
Content added Content deleted
(J)
(→‎{{header|C}}: shorten the example, to show all the zero sum subsets, you can kill the process if you got all you need from it. and its easier to follow without the bit math which doesn't change the time complexity anyway.)
Line 166: Line 166:
<lang c>#include <stdio.h>
<lang c>#include <stdio.h>
#include <stdlib.h>
#include <stdlib.h>
#include <stdint.h>
#include <string.h>


typedef struct { void* data; int weight; } item;
typedef struct {
char *word;
int weight;
} item_t;


item_t items[] = {
uint64_t subsum(item *x, int n)
{"alliance", -624},
{
{"archbishop", -915},
int i, j, w, from, to, step, pos = 0, neg = 0;
{"balm", 397},
uint64_t bit, *buf;
{"bonnet", 452},

{"brute", 870},
for (i = 0; i < n; i++)
{"centipede", -658},
if (x[i].weight >= 0) pos += x[i].weight;
{"cobol", 362},
else neg += x[i].weight;
{"covariate", 590},

{"departure", 952},
buf = calloc(pos - neg + 1, sizeof(uint64_t));
{"deploy", 44},
buf -= neg;
{"diophantine", 645},

{"efferent", 54},
for (i = 0; i < n; i++) {
{"elysee", -326},
w = x[i].weight;
{"eradicate", 376},
bit = (uint64_t)1 << i;
{"escritoire", 856},

{"exorcism", -983},
if (w < 0) from = neg, to = pos + 1, step = 1;
else from = pos, to = neg - 1, step = -1;
{"fiat", 170},
{"filmy", -874},

{"flatworm", 503},
for (j = from; j != to; j += step)
{"gestapo", 915},
if (buf[j]) buf[j + w] = buf[j] | bit;
{"infra", -847},
buf[w] = bit;
{"isis", -982},

{"lindholm", 999},
if (buf[0]) break;
{"markham", 475},
}
{"mincemeat", -880},

{"moresby", 756},
bit = buf[0];
{"mycenae", 183},
free(buf + neg);
{"plugging", -266},

{"smokescreen", 423},
return bit;
{"speakeasy", -745},
}
{"vein", 813},

int main(void)
{
item em[] = {
{"alliance", -624}, {"archbishop", -915}, {"balm", 397},
{"bonnet", 452}, {"brute", 870}, {"centipede", -658},
{"cobol", 362}, {"covariate", 590}, {"departure", 952},
{"deploy", 44}, {"diophantine", 645}, {"efferent", 54},
{"elysee", -326}, {"eradicate", 376}, {"escritoire", 856},
{"exorcism", -983}, {"fiat", 170}, {"filmy", -874},
{"flatworm", 503}, {"gestapo", 915}, {"infra", -847},
{"isis", -982}, {"lindholm", 999}, {"markham", 475},
{"mincemeat", -880}, {"moresby", 756}, {"mycenae", 183},
{"plugging", -266}, {"smokescreen", 423}, {"speakeasy", -745},
{"vein", 813}
};

uint64_t i, v, ret = subsum(em, sizeof(em)/sizeof(em[0]));
if (!ret) {
puts("no zero sums\n");
return 1;
}

puts("Found zero sum:");
for (i = 0; i < 64; i++) {
v = (uint64_t)1 << i;
if (ret & v)
printf("%2llu | %5d %s\n", i, em[i].weight, (char*)em[i].data);
}

return 0;
}</lang>{{out}}
Found zero sum:
1 | -915 archbishop
2 | 397 balm
3 | 452 bonnet
5 | -658 centipede
8 | 952 departure
9 | 44 deploy
11 | 54 efferent
12 | -326 elysee

Code for listing ''all'' zero sum sets. It's pretty fast for this example, takes seconds even if printing all 300k+ combinations is enabled.
<lang c>#include <stdio.h>
#include <stdlib.h>

typedef struct { const char* data; int weight; } item;
typedef struct { int sum; unsigned int mask; } sum_t;

item em[] = {
{"alliance", -624}, {"archbishop", -915}, {"balm", 397},
{"bonnet", 452}, {"brute", 870}, {"centipede", -658},
{"cobol", 362}, {"covariate", 590}, {"departure", 952},
{"deploy", 44}, {"diophantine", 645}, {"efferent", 54},
{"elysee", -326}, {"eradicate", 376}, {"escritoire", 856},
{"exorcism", -983}, {"fiat", 170}, {"filmy", -874},
{"flatworm", 503}, {"gestapo", 915}, {"infra", -847},
{"isis", -982}, {"lindholm", 999}, {"markham", 475},
{"mincemeat", -880}, {"moresby", 756}, {"mycenae", 183},
{"plugging", -266}, {"smokescreen", 423}, {"speakeasy", -745},
{"vein", 813}
};
};
#define N (sizeof(em)/sizeof(em[0]))


int n = sizeof (items) / sizeof (item_t);
int cmp_sums(const void *a, const void *b)
int *path;
{
return ((const sum_t*)a)->sum - ((const sum_t*)b)->sum;
}


sum_t *mksums(const item *p, int n, int shift)
void subsum (int i, int weight) {
int j;
{
if (i && !weight) {
sum_t *r = malloc(sizeof(*r) * (1 << n));
for (j = 0; j < i; j++) {
int i;
item_t item = items[path[j]];
for (i = 0; i < n; i++)
printf("%s%s", j ? " " : "", items[path[j]].word);
r[1<<i].sum = p[i].weight;
}

printf("\n");
r[0].mask = 0, r[0].sum = 0;
}

for (i = 1; i < 1<<n; i++) {
for (j = i ? path[i - 1] + 1: 0; j < n; j++) {
unsigned int b = i & -(int)i;
path[i] = j;
subsum(i + 1, weight + items[j].weight);
r[i].mask = i << shift;
}
r[i].sum = r[i & ~b].sum + r[b].sum;
}

qsort(r, 1<<n, sizeof(*r), cmp_sums);
return r;
}
}


int main(void)
int main () {
path = malloc(n * sizeof (int));
{
subsum(0, 0);
int n1 = N / 2, n2 = N - n1, i, j, i1, j1, sols = 0;
return 0;
#define SHOW_ALL 1
}</lang>
#define N1 (1 << n1)
#define N2 (1 << n2)
sum_t *l = mksums(em, n1, 0),
*r = mksums(em + n1, n2, n1);


{{output}}<pre>alliance archbishop balm bonnet brute centipede cobol covariate departure deploy diophantine efferent elysee eradicate escritoire exorcism fiat filmy flatworm mincemeat plugging speakeasy
void showmask(unsigned int mask)
...</pre>
{
unsigned int m;
for (m = 0; (1<<m) <= mask; m++) {
if (mask & (1<<m))
printf("(%s,%d) ", em[m].data, em[m].weight);
}
if (mask) puts("");
}

int printlist() {
int x, y, s = (i1 - i) * (j - j1);
if (!l[i].sum) s--;

if (SHOW_ALL)
for (x = i; x < i1; x++)
for (y = j; y > j1; y--)
showmask(l[x].mask | r[y].mask);
return s;
}

i = 0, j = N2 - 1;
while (1) {
while (l[i].sum + r[j].sum) {
while (i < N1 && l[i].sum + r[j].sum < 0) i++;
while (j >= 0 && l[i].sum + r[j].sum > 0) j--;
if (i >= N1 || j < 0) break;
}
if (i >= N1 || j < 0) break;

for (i1 = i + 1; i1 < N1 && l[i1].sum == l[i].sum; i1++);
for (j1 = j - 1; j1 >= 0 && r[j1].sum == r[j].sum; j1--);

sols += printlist();

i = i1, j = j1;
}
printf("zero sums: %d\n", sols);

return 0;
}</lang>


=={{header|D}}==
=={{header|D}}==

Revision as of 22:24, 1 March 2016

Subset sum problem is a draft programming task. It is not yet considered ready to be promoted as a complete task, for reasons that should be found in its talk page.

Implement a function/procedure/method/subroutine that takes a set/array/list/stream/table/collection of words with integer weights, and identifies a non-empty subset of them whose weights sum to zero (cf. the Dropbox Diet candidate screening exercise and the Subset sum problem Wikipedia article).

For example, for this set of weighted words, one solution would be the set of words {elysee, efferent, deploy, departure, centipede, bonnet, balm, archbishop}, because their respective weights of -326, 54, 44, 952, -658, 452, 397, and -915 sum to zero. |

Table of weighted words
word weight
alliance -624
archbishop -915
balm 397
bonnet 452
brute 870
centipede -658
cobol 362
covariate 590
departure 952
deploy 44
diophantine 645
efferent 54
elysee -326
eradicate 376
escritoire 856
exorcism -983
fiat 170
filmy -874
flatworm 503
gestapo 915
infra -847
isis -982
lindholm 999
markham 475
mincemeat -880
moresby 756
mycenae 183
plugging -266
smokescreen 423
speakeasy -745
vein 813

Another solution would be the set of words {flatworm, gestapo, infra, isis, lindholm, plugging, smokescreen, speakeasy}, because their respective weights of 503, 915, -847, -982, 999, -266, 423, and -745 also sum to zero.

You may assume the weights range from -1000 to 1000. If there are multiple solutions, only one needs to be found. Use any algorithm you want and demonstrate it on a set of at least 30 weighted words with the results shown in a human readable form. Note that an implementation that depends on enumerating all possible subsets is likely to be infeasible.

Ada

<lang Ada>with Ada.Text_IO; use Ada.Text_IO; with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; procedure SubsetSum is 

  function "+"(S:String) return Unbounded_String renames To_Unbounded_String;
  type Point is record
     str : Unbounded_String;
     num : Integer;
  end record;
  type Points is array (Natural range <>) of Point;
  type Indices is array (Natural range <>) of Natural;

  procedure Print (data : Points; list : Indices; len : Positive) is begin
     Put (len'Img & ":");
     for i in 0..len-1 loop
        Put (" "& To_String(data(list(i)).str));
     end loop; New_Line;
  end Print;

  function Check (data : Points; list : Indices; len : Positive) return Boolean is
     sum : Integer := 0;
  begin
     for i in 0..len-1 loop sum := sum + data(list(i)).num; end loop;
     return sum = 0;
  end Check;

  procedure Next (list : in out Indices; n, r : Positive ) is begin
     for i in reverse 0..r-1 loop
        if list(i)/=i+n-r then list(i):=list(i)+1;
           for j in i+1..r-1 loop list(j):=list(j-1)+1; end loop; exit;
        end if;
     end loop;
  end Next;

  data : constant Points := ((+"alliance", -624), (+"archbishop", -915),
     (+"balm", 397), (+"bonnet", 452), (+"brute", 870),
     (+"centipede", -658), (+"cobol", 362), (+"covariate", 590),
     (+"departure", 952), (+"deploy", 44), (+"diophantine", 645),
     (+"efferent", 54), (+"elysee", -326), (+"eradicate", 376),
     (+"escritoire", 856), (+"exorcism", -983), (+"fiat", 170),
     (+"filmy", -874), (+"flatworm", 503), (+"gestapo", 915),
     (+"infra", -847), (+"isis", -982), (+"lindholm", 999),
     (+"markham", 475), (+"mincemeat", -880), (+"moresby", 756),
     (+"mycenae", 183), (+"plugging", -266), (+"smokescreen", 423),
     (+"speakeasy", -745), (+"vein", 813));
  list, last : Indices (data'Range);

begin 

  for len in 2..data'Length loop
     for i in 0..len-1 loop list(i):=i; end loop;
     loop
        if Check(data, list, len) then Print(data, list, len); exit; end if;
        last := list;
        Next(list, data'Length, len);
        exit when last=list;
     end loop;
  end loop;

end SubsetSum;</lang>

Output:
2: archbishop gestapo
3: centipede markham mycenae
4: alliance balm deploy mycenae
5: alliance brute covariate deploy mincemeat
6: alliance archbishop balm deploy gestapo mycenae
7: alliance archbishop bonnet cobol departure exorcism moresby
8: alliance archbishop balm bonnet fiat flatworm isis lindholm
9: alliance archbishop balm bonnet brute covariate eradicate mincemeat plugging
10: alliance archbishop balm bonnet brute centipede cobol departure deploy mincemeat
11: alliance archbishop balm bonnet brute centipede cobol departure infra moresby speakeasy
12: alliance archbishop balm bonnet brute centipede cobol covariate diophantine efferent elysee infra
13: alliance archbishop balm bonnet brute centipede cobol covariate departure efferent eradicate filmy isis
14: alliance archbishop balm bonnet brute centipede cobol covariate departure deploy elysee filmy markham speakeasy
15: alliance archbishop balm bonnet brute centipede cobol covariate departure deploy elysee exorcism flatworm infra mycenae
16: alliance archbishop balm bonnet brute centipede cobol covariate departure deploy diophantine elysee exorcism filmy gestapo infra
17: alliance archbishop balm bonnet brute centipede cobol covariate departure deploy diophantine exorcism isis mincemeat mycenae plugging vein
18: alliance archbishop balm bonnet brute centipede cobol covariate departure deploy diophantine efferent elysee exorcism filmy isis mycenae vein
19: alliance archbishop balm bonnet brute centipede cobol covariate departure deploy diophantine efferent elysee eradicate exorcism fiat infra isis smokescreen
20: alliance archbishop balm bonnet brute centipede cobol covariate departure deploy diophantine efferent elysee eradicate exorcism gestapo infra isis smokescreen speakeasy
21: alliance archbishop balm bonnet brute centipede cobol covariate departure deploy diophantine efferent elysee eradicate exorcism flatworm infra lindholm mincemeat plugging speakeasy
22: alliance archbishop balm bonnet brute centipede cobol covariate departure deploy diophantine efferent elysee eradicate escritoire exorcism fiat filmy flatworm mincemeat plugging speakeasy
23: alliance archbishop balm bonnet brute centipede cobol covariate departure deploy diophantine efferent elysee eradicate escritoire exorcism infra isis mincemeat moresby mycenae smokescreen speakeasy
24: alliance archbishop balm bonnet brute centipede cobol covariate departure deploy diophantine efferent elysee exorcism filmy gestapo infra markham mincemeat moresby mycenae plugging smokescreen speakeasy
25: alliance archbishop balm bonnet brute centipede cobol covariate departure deploy diophantine eradicate exorcism fiat filmy flatworm infra isis lindholm markham mincemeat moresby mycenae plugging speakeasy
26: alliance archbishop balm bonnet brute centipede cobol covariate departure deploy diophantine elysee eradicate escritoire exorcism fiat filmy gestapo infra isis markham mincemeat mycenae plugging speakeasy vein
27: alliance archbishop balm bonnet brute centipede covariate departure deploy efferent elysee eradicate escritoire exorcism fiat filmy flatworm infra isis lindholm markham mincemeat moresby mycenae plugging smokescreen speakeasy

C

<lang c>#include <stdio.h>

  1. include <stdlib.h>

typedef struct { 

   char *word;
   int weight;

} item_t;

item_t items[] = { 

   {"alliance",     -624},
   {"archbishop",   -915},
   {"balm",          397},
   {"bonnet",        452},
   {"brute",         870},
   {"centipede",    -658},
   {"cobol",         362},
   {"covariate",     590},
   {"departure",     952},
   {"deploy",         44},
   {"diophantine",   645},
   {"efferent",       54},
   {"elysee",       -326},
   {"eradicate",     376},
   {"escritoire",    856},
   {"exorcism",     -983},
   {"fiat",          170},
   {"filmy",        -874},
   {"flatworm",      503},
   {"gestapo",       915},
   {"infra",        -847},
   {"isis",         -982},
   {"lindholm",      999},
   {"markham",       475},
   {"mincemeat",    -880},
   {"moresby",       756},
   {"mycenae",       183},
   {"plugging",     -266},
   {"smokescreen",   423},
   {"speakeasy",    -745},
   {"vein",          813},

};

int n = sizeof (items) / sizeof (item_t); int *path;

void subsum (int i, int weight) { 

   int j;
   if (i && !weight) {
       for (j = 0; j < i; j++) {
           item_t item = items[path[j]];
           printf("%s%s", j ? " " : "", items[path[j]].word);
       }
       printf("\n");
   }
   for (j = i ? path[i - 1] + 1: 0; j < n; j++) {
       path[i] = j;
       subsum(i + 1, weight + items[j].weight);
   }

}

int main () { 

   path = malloc(n * sizeof (int));
   subsum(0, 0);
   return 0;

}</lang>

Output:
alliance archbishop balm bonnet brute centipede cobol covariate departure deploy diophantine efferent elysee eradicate escritoire exorcism fiat filmy flatworm mincemeat plugging speakeasy
...

D

A simple brute-force solution. This used the module of the third D solution of the Combinations Task.

Translation of: Ruby

<lang d>void main() { 

   import std.stdio, std.algorithm, std.typecons, combinations3;

   alias P = tuple;
   immutable items = [

P("alliance", -624), P("archbishop", -915), P("balm", 397), P("bonnet", 452), P("brute", 870), P("centipede", -658), P("cobol", 362), P("covariate", 590), P("departure", 952), P("deploy", 44), P("diophantine", 645), P("efferent", 54), P("elysee", -326), P("eradicate", 376), P("escritoire", 856), P("exorcism", -983), P("fiat", 170), P("filmy", -874), P("flatworm", 503), P("gestapo", 915), P("infra", -847), P("isis", -982), P("lindholm", 999), P("markham", 475), P("mincemeat", -880), P("moresby", 756), P("mycenae", 183), P("plugging", -266), P("smokescreen", 423), P("speakeasy", -745), P("vein", 813)]; 

   foreach (immutable n; 1 .. items.length)
       foreach (const comb; items.combinations(n))
           if (comb.map!q{ a[1] }.sum == 0)
               return writefln("A subset of length %d: %-(%s, %)", n,
                               comb.map!q{ a[0] });
   "No solution found.".writeln;

}</lang>

Output:
A subset of length 2: archbishop, gestapo

Alternative Version

This version prints all the 349_167 solutions in about 1.8 seconds and counts them in about 0.05 seconds.

Translation of: C

<lang d>import std.stdio, std.algorithm;

enum showAllSolutions = true;

struct Item { string data; int weight; } struct Sum { int sum; uint mask; }

immutable Item[] em = [ 

   {"alliance",  -624},  {"archbishop",  -915},  {"balm",        397},
   {"bonnet",     452},  {"brute",        870},  {"centipede",  -658},
   {"cobol",      362},  {"covariate",    590},  {"departure",   952},
   {"deploy",      44},  {"diophantine",  645},  {"efferent",     54},
   {"elysee",    -326},  {"eradicate",    376},  {"escritoire",  856},
   {"exorcism",  -983},  {"fiat",         170},  {"filmy",      -874},
   {"flatworm",   503},  {"gestapo",      915},  {"infra",      -847},
   {"isis",      -982},  {"lindholm",     999},  {"markham",     475},
   {"mincemeat", -880},  {"moresby",      756},  {"mycenae",     183},
   {"plugging",  -266},  {"smokescreen",  423},  {"speakeasy",  -745},
   {"vein",       813}];

Sum[] mkSums(in Item[] p, in size_t n, in size_t shift) { 

   auto r = new Sum[1 << n];
   foreach (immutable i; 0 .. n)
       r[1 << i].sum = p[i].weight;

   foreach (immutable i, ref ri; r) {
       immutable size_t b = i & -int(i);
       ri = Sum(r[i & ~b].sum + r[b].sum, i << shift);
   }

   return r.sort!q{ a.sum < b.sum }.release;

}

void showMask(in uint mask) nothrow { 

   for (size_t m = 0; (1U << m) <= mask; m++)
       if (mask & (1U << m))
           // Much faster than writeln.
           // The names are all zero-terminated.
           printf("%s ", em[m].data.ptr);
   if (mask)
       putchar('\n');

}

int printList(in int i, in int j, in int i1, in int j1, 

             in Sum[] l, in Sum[] r) nothrow {
   int s = (i1 - i) * (j - j1);
   if (!l[i].sum)
       s--;

   static if (showAllSolutions)
       foreach (immutable x; i .. i1)
           foreach_reverse (immutable size_t y; j1 + 1 .. j + 1)
               showMask(l[x].mask | r[y].mask);
   return s;

}

void main() { 

   immutable N = em.length;
   assert(N <= em[0].sizeof * 8, "Not enough bits in the mask");
   immutable size_t n1 = N / 2;
   immutable size_t n2 = N - n1;
   immutable size_t n1p = 1 << n1;
   immutable size_t n2p = 1 << n2;

   auto l = mkSums(em[], n1, 0);
   auto r = mkSums(em[n1 .. $], n2, n1);

   size_t sols = 0;
   int i = 0;
   int j = n2p - 1;
   while (true) {
       while (l[i].sum + r[j].sum) {
           while (i < n1p && l[i].sum + r[j].sum < 0)
               i++;
           while (j >= 0 && l[i].sum + r[j].sum > 0)
               j--;
           if (i >= n1p || j < 0)
               break;
       }
       if (i >= n1p || j < 0)
           break;

       int i1 = i + 1;
       while (i1 < n1p && l[i1].sum == l[i].sum)
           i1++;

       int j1 = j - 1;
       while (j1 >= 0 && r[j1].sum == r[j].sum)
           j1--;

       sols += printList(i, j, i1, j1, l, r);
       i = i1;
       j = j1;
   }

   writeln("Zero sums: ", sols);

}</lang>

Output:
Zero sums: 349167

FunL

<lang funl>def subsetSum( s, w, v ) = 

 def sumset( a ) = foldl1( (+), map(w, a) )
   
 for i <- s.subsets() if i != {}
   if sumset( i ) == v
     return Some( i )
     
 None

s = { 

 ('alliance', -624),
 ('archbishop', -915),
 ('balm', 397),
 ('bonnet', 452),
 ('brute', 870),
 ('centipede', -658),
 ('cobol', 362),
 ('covariate', 590),
 ('departure', 952),
 ('deploy', 44),
 ('diophantine', 645),
 ('efferent', 54),
 ('elysee', -326),
 ('eradicate', 376),
 ('escritoire', 856),
 ('exorcism', -983),
 ('fiat', 170),
 ('filmy', -874),
 ('flatworm', 503),
 ('gestapo', 915),
 ('infra', -847),
 ('isis', -982),
 ('lindholm', 999),
 ('markham', 475),
 ('mincemeat', -880),
 ('moresby', 756),
 ('mycenae', 183),
 ('plugging', -266),
 ('smokescreen', 423),
 ('speakeasy', -745),
 ('vein', 813)
 }

for i <- 0..5 

 println( i, subsetSum(s, snd, i).get() )</lang>
Output:
0, {(archbishop, -915), (gestapo, 915)}
1, {(fiat, 170), (vein, 813), (isis, -982)}
2, {(alliance, -624), (departure, 952), (elysee, -326)}
3, {(alliance, -624), (archbishop, -915), (departure, 952), (covariate, 590)}
4, {(markham, 475), (infra, -847), (eradicate, 376)}
5, {(flatworm, 503), (eradicate, 376), (filmy, -874)}

Go

<lang go>package main

import "fmt"

type ww struct { 

   word   string
   weight int

}

var input = []*ww{ 

   {"alliance", -624},
   {"archbishop", -915},
   {"balm", 397},
   {"bonnet", 452},
   {"brute", 870},
   {"centipede", -658},
   {"cobol", 362},
   {"covariate", 590},
   {"departure", 952},
   {"deploy", 44},
   {"diophantine", 645},
   {"efferent", 54},
   {"elysee", -326},
   {"eradicate", 376},
   {"escritoire", 856},
   {"exorcism", -983},
   {"fiat", 170},
   {"filmy", -874},
   {"flatworm", 503},
   {"gestapo", 915},
   {"infra", -847},
   {"isis", -982},
   {"lindholm", 999},
   {"markham", 475},
   {"mincemeat", -880},
   {"moresby", 756},
   {"mycenae", 183},
   {"plugging", -266},
   {"smokescreen", 423},
   {"speakeasy", -745},
   {"vein", 813},

}

type sss struct { 

   subset []*ww
   sum    int

}

func main() { 

   ps := []sssTemplate:Nil, 0
   for _, i := range input {
       pl := len(ps)
       for j := 0; j < pl; j++ {
           subset := append([]*ww{i}, ps[j].subset...)
           sum := i.weight + ps[j].sum
           if sum == 0 {
               fmt.Println("this subset sums to 0:")
               for _, i := range subset {
                   fmt.Println(*i)
               }
               return
           }
           ps = append(ps, sss{subset, sum})
       }
   }
   fmt.Println("no subset sums to 0")

}</lang>

Output:
this subset sums to 0:
{elysee -326}
{efferent 54}
{deploy 44}
{covariate 590}
{cobol 362}
{centipede -658}
{bonnet 452}
{balm 397}
{archbishop -915}

Haskell

<lang haskell>combinations :: Int -> [a] -> a combinations 0 _ = [[]] combinations _ [] = [] combinations k (x:xs) = map (x:) (combinations (k - 1) xs) ++ 

                         combinations k xs

data W = W { word  :: String, 

            weight :: Int }

solver :: [W] -> W solver it = [comb | n <- [1 .. length it], 

                   comb <- combinations n it,
                   sum (map weight comb) == 0]

items = [W "alliance" (-624), W "archbishop" (-915), 

         W "balm"          397,   W "bonnet"       452,
         W "brute"         870,   W "centipede"  (-658),
         W "cobol"         362,   W "covariate"    590,
         W "departure"     952,   W "deploy"        44,
         W "diophantine"   645,   W "efferent"      54,
         W "elysee"      (-326),  W "eradicate"    376,
         W "escritoire"    856,   W "exorcism"   (-983),
         W "fiat"          170,   W "filmy"      (-874),
         W "flatworm"      503,   W "gestapo"      915,
         W "infra"       (-847),  W "isis"       (-982),
         W "lindholm"      999,   W "markham"      475,
         W "mincemeat"   (-880),  W "moresby"      756,
         W "mycenae"       183,   W "plugging"   (-266),
         W "smokescreen"   423,   W "speakeasy"  (-745),
         W "vein"          813]

main = print $ map word $ head $ solver items</lang>

Output:
["archbishop","gestapo"]

None bruteforce: the list of numbers used here are different, and difficult for a bruteforce method. <lang haskell>subsum w = snd.head.filter ((==w).fst).(++[(w,[])]).foldl s [(0,[])] where s a x = merge a $ map f a where f (a,l) = (a+x, l++[x])

-- keep list of sums sorted and unique merge [] a = a merge a [] = a merge a@((av,al):as) b@((bv,bl):bs) | av < bv = (av,al):merge as b | av == bv = (bv,bl):merge as bs | otherwise = (bv,bl):merge a bs

items = [-61, 1, 32, 373, 311, 249, 311, 32, -92, -185, -433, -402, -247, 156, 125, 249, 32, -464, -278, 218, 32, -123, -216, 373, -185, -402, 156, -402, -61, -31, 902 ]

main = print $ subsum 0 items</lang>

Output:
[-61,32,373,311,249,311,32,-92,-185,-433,-402,-247,156,125,249,32,-464,-278,218,32,-123,-216,373,-185,-402,156,-402,-61,902]

Icon and Unicon

Translation of: Ruby

<lang Icon>link printf,lists

procedure main() 

  BruteZeroSubset(string2table(
       "alliance/-624/archbishop/-915/balm/397/bonnet/452/brute/870/_
        centipede/-658/cobol/362/covariate/590/departure/952/deploy/44/_
        diophantine/645/efferent/54/elysee/-326/eradicate/376/escritoire/856/_
        exorcism/-983/fiat/170/filmy/-874/flatworm/503/gestapo/915/infra/-847/_
        isis/-982/lindholm/999/markham/475/mincemeat/-880/moresby/756/_
        mycenae/183/plugging/-266/smokescreen/423/speakeasy/-745/vein/813/"))

end

procedure BruteZeroSubset(words) # brute force 1 of each length 

  every n := 1 to *words do {
     every t := tcomb(words,n) do {            # generate combination   
        every (sum := 0) +:= words[!t]         # sum combination 
        if sum = 0 then {
           printf("A zero-sum subset of length %d : %s\n",n,list2string(sort(t)))
           break next                          # found one
           }
        }
        printf("No zero-sum subsets of length %d\n",n)
     }

end

  1. helper procedures

procedure tcomb(T, i) #: Table (key) combinations 

  local K
  every put(K := [],key(T))        # list of keys
  every suspend lcomb(K,i)         # return list combs

end

procedure list2string(L) #: format list as a string 

  every (s := "[ ") ||:= !L || " " # reformat as string
  return s || "]"

end

procedure string2table(s,d) #: format string "k1/v1/.../kn/vn" as table 

  T := table()
  /d := "/"
  s ? until pos(0) do 
     T[1(tab(find(d)),=d)] := numeric(1(tab(find(d)),=d))

  return T

end</lang>

Library: Icon Programming Library

printf.icn provides formatting lists.icn provides lcomb for list combinations

Output:
No zero-sum subsets of length 1

A zero-sum subset of length 2 : [ archbishop gestapo ]
A zero-sum subset of length 3 : [ centipede markham mycenae ]
A zero-sum subset of length 4 : [ alliance balm deploy mycenae ]
A zero-sum subset of length 5 : [ balm eradicate isis markham plugging ]
A zero-sum subset of length 6 : [ archbishop balm escritoire exorcism fiat markham ]
A zero-sum subset of length 7 : [ balm bonnet cobol fiat filmy isis markham ]
A zero-sum subset of length 8 : [ balm bonnet cobol filmy markham mincemeat speakeasy vein ]
A zero-sum subset of length 9 : [ alliance archbishop balm bonnet cobol lindholm markham mincemeat plugging ]
A zero-sum subset of length 10 : [ archbishop balm bonnet cobol filmy gestapo markham mincemeat speakeasy vein ]
A zero-sum subset of length 11 : [ alliance archbishop balm bonnet cobol deploy gestapo isis markham mincemeat moresby ]
A zero-sum subset of length 12 : [ alliance archbishop balm bonnet cobol exorcism fiat lindholm markham mincemeat plugging vein ]
A zero-sum subset of length 13 : [ alliance archbishop balm bonnet brute cobol deploy diophantine exorcism markham mincemeat plugging smokescreen ]
A zero-sum subset of length 14 : [ alliance archbishop balm bonnet centipede cobol diophantine exorcism lindholm markham mincemeat mycenae plugging vein ]
A zero-sum subset of length 15 : [ alliance archbishop balm bonnet cobol diophantine fiat gestapo isis markham mincemeat mycenae plugging speakeasy vein ]
A zero-sum subset of length 16 : [ alliance archbishop balm bonnet brute cobol diophantine eradicate exorcism filmy infra lindholm markham mincemeat plugging vein ]
A zero-sum subset of length 17 : [ alliance archbishop balm bonnet centipede cobol covariate deploy diophantine exorcism filmy lindholm markham mincemeat plugging smokescreen vein ]
A zero-sum subset of length 18 : [ alliance archbishop balm bonnet centipede cobol diophantine eradicate escritoire exorcism filmy gestapo infra markham mincemeat moresby plugging vein ]
A zero-sum subset of length 19 : [ alliance archbishop balm bonnet cobol diophantine efferent exorcism filmy flatworm gestapo infra isis lindholm markham mincemeat moresby plugging vein ]
A zero-sum subset of length 20 : [ alliance archbishop balm bonnet centipede cobol deploy diophantine efferent escritoire exorcism fiat filmy gestapo isis lindholm markham mincemeat plugging vein ]
A zero-sum subset of length 21 : [ alliance archbishop balm bonnet brute centipede cobol covariate deploy diophantine efferent elysee exorcism filmy gestapo infra markham mincemeat moresby plugging vein ]
A zero-sum subset of length 22 : [ alliance archbishop balm bonnet centipede cobol deploy diophantine eradicate escritoire exorcism fiat filmy gestapo isis lindholm markham mincemeat plugging smokescreen speakeasy vein ]
A zero-sum subset of length 23 : [ alliance archbishop balm bonnet brute centipede cobol covariate departure deploy diophantine exorcism filmy flatworm gestapo infra isis markham mincemeat moresby plugging speakeasy vein ]
A zero-sum subset of length 24 : [ alliance archbishop balm bonnet brute centipede cobol departure deploy diophantine efferent escritoire exorcism filmy gestapo infra isis markham mincemeat moresby mycenae plugging speakeasy vein ]
A zero-sum subset of length 25 : [ alliance archbishop balm bonnet brute centipede cobol covariate deploy diophantine efferent elysee eradicate exorcism filmy gestapo infra isis markham mincemeat moresby mycenae plugging smokescreen vein ]
A zero-sum subset of length 26 : [ alliance archbishop balm bonnet centipede cobol covariate departure deploy diophantine efferent elysee eradicate escritoire exorcism fiat filmy gestapo infra isis lindholm markham mincemeat plugging speakeasy vein ]
A zero-sum subset of length 27 : [ alliance archbishop balm bonnet brute centipede covariate departure deploy efferent elysee eradicate escritoire exorcism fiat filmy flatworm infra isis lindholm markham mincemeat moresby mycenae plugging smokescreen speakeasy ]
No zero-sum subsets of length 28
No zero-sum subsets of length 29
No zero-sum subsets of length 30


No zero-sum subsets of length 31

J

Task data:

<lang J>text=:0 :0 alliance -624 archbishop -915 balm 397 bonnet 452 brute 870 centipede -658 cobol 362 covariate 590 departure 952 deploy 44 diophantine 645 efferent 54 elysee -326 eradicate 376 escritoire 856 exorcism -983 fiat 170 filmy -874 flatworm 503 gestapo 915 infra -847 isis -982 lindholm 999 markham 475 mincemeat -880 moresby 756 mycenae 183 plugging -266 smokescreen 423 speakeasy -745 vein 813 )

words=:{.@;:;._2 text numbs=:+/|:0&".;._2 text</lang>

Implementation:

<lang J>wsum0=:4 :0 

 p=:(#~ 0&<)y
 n=:(#~ 0&>)y
 poss=: +/@#~2#.inv 2 i.@^#
 P=:poss p
 N=:poss -n
 choose=:(1{I.P e. N){P
 keep=: [ #~ #&2@#@[ #: choose i.~ ]
 ;:inv words #~y e. (p keep P),n keep N

)</lang>

Task example:

<lang J> words wsum0 numbs centipede markham mycenae</lang>

Mathematica

<lang Mathematica>a = {{"alliance", -624}, {"archbishop", -915}, {"balm", 397}, {"bonnet", 452}, {"brute", 870}, {"centipede", -658}, {"cobol", 362}, {"covariate", 590},{"departure", 952}, {"deploy", 44}, {"diophantine", 645}, {"efferent", 54}, {"elysee", -326}, {"eradicate", 376}, {"escritoire", 856}, {"exorcism", -983}, {"fiat", 170}, {"filmy", -874}, {"flatworm", 503}, {"gestapo", 915}, {"infra", -847}, {"isis", -982}, {"lindholm", 999}, {"markham", 475}, {"mincemeat", -880}, {"moresby", 756}, {"mycenae", 183}, {"plugging", -266}, {"smokescreen", 423}, {"speakeasy", -745}, {"vein", 813}};

result = Rest@Select[ Subsets[a, 7], (Total[#;; , 2] == 0) &]; Map[ (Print["A zero-sum subset of length ", Length[#], " : ", #;; , 1])& , result ]</lang> 

A zero-sum subset of length 2 : {archbishop,gestapo}
A zero-sum subset of length 3 : {centipede,markham,mycenae}
A zero-sum subset of length 3 : {exorcism,fiat,vein}
A zero-sum subset of length 4 : {alliance,balm,deploy,mycenae}
A zero-sum subset of length 4 : {balm,efferent,filmy,smokescreen}
A zero-sum subset of length 4 : {bonnet,elysee,escritoire,isis}
A zero-sum subset of length 4 : {brute,centipede,efferent,plugging}
....

The above code uses a brute-force approach, but Mathematica includes several solution schemes that can be used to solve this problem. We can cast it as an integer linear programming problem, and thus find the largest or smallest subset sum, or even sums with specific constraints, such as a sum using three negative values and nine positive values.

<lang Mathematica>a = {{"alliance", -624}, {"archbishop", -915}, {"balm", 397}, {"bonnet", 452}, {"brute", 870}, {"centipede", -658}, {"cobol", 362}, {"covariate", 590},{"departure", 952}, {"deploy", 44}, {"diophantine", 645}, {"efferent", 54}, {"elysee", -326}, {"eradicate", 376}, {"escritoire", 856}, {"exorcism", -983}, {"fiat", 170}, {"filmy", -874}, {"flatworm", 503}, {"gestapo", 915}, {"infra", -847}, {"isis", -982}, {"lindholm", 999}, {"markham", 475}, {"mincemeat", -880}, {"moresby", 756}, {"mycenae", 183}, {"plugging", -266}, {"smokescreen", 423}, {"speakeasy", -745}, {"vein", 813}};

desiredValue = 0; aNames = #1 & /@ a; aValues = #2 & /@ a; aOnes = ConstantArray[1, Length[a]]; aZeroOnes = ConstantArray[{0, 1}, Length[a]]; Off[LinearProgramming::lpip];

maxSoln = 

LinearProgramming[-aOnes, {aValues}, Template:DesiredValue, 0, aZeroOnes, Integers];

Print["Maximal solution: ", Select[Transpose[{maxSoln*aValues, aNames}], #1 != 0 &]];

minSoln = 

LinearProgramming[
 aOnes, {aValues, aOnes}, {{desiredValue, 0}, {1, 1}}, aZeroOnes, Integers];

Print["Minimal solution: ", Select[Transpose[{minSoln*aValues, aNames}], #1 != 0 &]];

threeNineSoln = 

LinearProgramming[
 aOnes, {aValues,
         Boole[# < 0] & /@ aValues, 
         Boole[# > 0] & /@ aValues},
 {{desiredValue, 0}, {3, 0}, {9, 0}}, aZeroOnes, Integers];

Print["3 -ves, 9 +ves: ", Select[Transpose[{threeNineSoln*aValues, aNames}], #1 != 0 &]]; </lang> 

Maximal solution: {{-624, alliance}, {-915, archbishop}, {397, balm}, 
    {870, brute}, {-658, centipede}, {362, cobol}, {590, covariate}, 
    {44, deploy}, {645, diophantine}, {54, efferent}, {-326, elysee}, 
    {376, eradicate}, {-983, exorcism}, {170, fiat}, {-874, filmy}, 
    {503, flatworm}, {915, gestapo}, {-847, infra}, {-982, isis}, 
    {999, lindholm}, {-880, mincemeat}, {756, moresby}, {183, mycenae}, 
    {-266, plugging}, {423, smokescreen}, {-745, speakeasy}, {813, vein}}

Minimal solution: {{-915, archbishop}, {915, gestapo}}

3 -ves, 9 +ves: {{-915, archbishop}, {397, balm}, {452, bonnet}, 
    {362, cobol}, {44, deploy}, {54, efferent}, {-983, exorcism}, 
    {170, fiat}, {503, flatworm}, {-982, isis}, {475, markham}, 
    {423, smokescreen}}.

OCaml

Just search randomly until a result is found:

<lang ocaml>let d = 

 [ "alliance", -624;  "archbishop", -915;  "balm", 397;  "bonnet", 452;
   "brute", 870;  "centipede", -658;  "cobol", 362;  "covariate", 590;
   "departure", 952;  "deploy", 44;  "diophantine", 645;  "efferent", 54;
   "elysee", -326;  "eradicate", 376;  "escritoire", 856;  "exorcism", -983;
   "fiat", 170;  "filmy", -874;  "flatworm", 503;  "gestapo", 915;
   "infra", -847;  "isis", -982;  "lindholm", 999;  "markham", 475;
   "mincemeat", -880;  "moresby", 756;  "mycenae", 183;  "plugging", -266;
   "smokescreen", 423;  "speakeasy", -745;  "vein", 813; ]

let sum = List.fold_left (fun sum (_,w) -> sum + w) 0 let p = function [] -> false | lst -> (sum lst) = 0

let take lst set = 

 let x = List.nth set (Random.int (List.length set)) in
 (x::lst, List.filter (fun y -> y <> x) set)

let swap (a, b) = (b, a) let pop lst set = swap (take set lst)

let () = 

 Random.self_init ();
 let rec aux lst set =
   let f =
     match lst, set with
     | [], _ -> take
     | _, [] -> pop
     | _ -> if Random.bool () then take else pop
   in
   let lst, set = f lst set in
   if p lst then lst
   else aux lst set
 in
 let res = aux [] d in
 List.iter (fun (n,w) -> Printf.printf " %4d\t%s\n" w n) res</lang>

Perl

Library: ntheory

<lang perl>use ntheory qw/:all/; my $print_all_combinations = 0;

my %pairs = ( 

   alliance => -624, archbishop => -915, balm => 397, bonnet => 452,
   brute => 870, centipede => -658, cobol => 362, covariate => 590,
   departure => 952, deploy => 44, diophantine => 645, efferent => 54,
   elysee => -326, eradicate => 376, escritoire => 856, exorcism => -983,
   fiat => 170, filmy => -874, flatworm => 503, gestapo => 915,
   infra => -847, isis => -982, lindholm => 999, markham => 475,
   mincemeat => -880, moresby => 756, mycenae => 183, plugging => -266,
   smokescreen => 423, speakeasy => -745, vein => 813 );

my @names = keys(%pairs); my @weights = values(%pairs);

if ($print_all_combinations) { 

 foreach my $n (1 .. @names) {
   forcomb {
     print "Length $n: @names[@_]\n" unless vecsum(@weights[@_]);
   } @names, $n;
 }

} else { 

 foreach my $n (1 .. @names) {
   eval {
     forcomb {
       if (vecsum(@weights[@_]) == 0) {
         print "Length $n: @names[@_]\n";
         die;
       }
     } @names, $n;
   };
 }

}</lang> Printing just the first one found for each number of elements:

Output:
Length 2: archbishop gestapo
Length 3: exorcism fiat vein
Length 4: efferent plugging brute centipede
Length 5: efferent exorcism cobol fiat balm
Length 6: efferent exorcism isis vein gestapo mycenae
Length 7: efferent exorcism isis cobol covariate gestapo deploy
Length 8: efferent exorcism isis speakeasy covariate vein escritoire balm
Length 9: efferent exorcism isis speakeasy cobol markham smokescreen lindholm balm
... to length 27 ...

We can also use different modules. Assuming the same pairs/names/weights variables set and first combination only, this iterator style is a little cleaner when wanting to exit early: <lang perl>use List::Util qw/sum/; use Algorithm::Combinatorics qw/combinations/; foreach my $n (1 .. @names) { 

 my $iter = combinations([0..$#weights], $n);
 while (my $c = $iter->next) {
   next if sum(@weights[@$c]);
   print "Length $n: @names[@$c]\n";
   last;
 }

}</lang>

Perl 6

<lang perl6>my @pairs = 

   alliance => -624, archbishop => -915, balm => 397, bonnet => 452,
   brute => 870, centipede => -658, cobol => 362, covariate => 590,
   departure => 952, deploy => 44, diophantine => 645, efferent => 54,
   elysee => -326, eradicate => 376, escritoire => 856, exorcism => -983,
   fiat => 170, filmy => -874, flatworm => 503, gestapo => 915,
   infra => -847, isis => -982, lindholm => 999, markham => 475,
   mincemeat => -880, moresby => 756, mycenae => 183, plugging => -266,
   smokescreen => 423, speakeasy => -745, vein => 813;

my @weights = @pairs».value; my %name = @pairs.hash.invert;

for 1..^@weights -> $n { 

   given @weights.combinations($n).first({ 0 == [+] @^comb }) {

when .so { say "Length $n: ", .map: {%name{$_}} } default { say "Length $n: (none)" } 

   }

}</lang>

Output:
Length 1: (none)
Length 2: archbishop gestapo
Length 3: centipede markham mycenae
Length 4: alliance balm deploy mycenae
Length 5: alliance brute covariate deploy mincemeat
Length 6: alliance archbishop balm deploy gestapo mycenae
Length 7: alliance archbishop bonnet cobol departure exorcism moresby
Length 8: alliance archbishop balm bonnet fiat flatworm isis lindholm
Length 9: alliance archbishop balm bonnet brute covariate eradicate mincemeat plugging
Length 10: alliance archbishop balm bonnet brute centipede cobol departure deploy mincemeat
Length 11: alliance archbishop balm bonnet brute centipede cobol departure infra moresby speakeasy
Length 12: alliance archbishop balm bonnet brute centipede cobol covariate diophantine efferent elysee infra
Length 13: alliance archbishop balm bonnet brute centipede cobol covariate departure efferent eradicate filmy isis
Length 14: alliance archbishop balm bonnet brute centipede cobol covariate departure deploy elysee filmy markham speakeasy
Length 15: alliance archbishop balm bonnet brute centipede cobol covariate departure deploy elysee exorcism flatworm infra mycenae
Length 16: alliance archbishop balm bonnet brute centipede cobol covariate departure deploy diophantine elysee exorcism filmy gestapo infra
Length 17: alliance archbishop balm bonnet brute centipede cobol covariate departure deploy diophantine exorcism isis mincemeat mycenae plugging vein
Length 18: alliance archbishop balm bonnet brute centipede cobol covariate departure deploy diophantine efferent elysee exorcism filmy isis mycenae vein
Length 19: alliance archbishop balm bonnet brute centipede cobol covariate departure deploy diophantine efferent elysee eradicate exorcism fiat infra isis smokescreen
Length 20: alliance archbishop balm bonnet brute centipede cobol covariate departure deploy diophantine efferent elysee eradicate exorcism gestapo infra isis smokescreen speakeasy
Length 21: alliance archbishop balm bonnet brute centipede cobol covariate departure deploy diophantine efferent elysee eradicate exorcism flatworm infra lindholm mincemeat plugging speakeasy
Length 22: alliance archbishop balm bonnet brute centipede cobol covariate departure deploy diophantine efferent elysee eradicate escritoire exorcism fiat filmy flatworm mincemeat plugging speakeasy
Length 23: alliance archbishop balm bonnet brute centipede cobol covariate departure deploy diophantine efferent elysee eradicate escritoire exorcism infra isis mincemeat moresby mycenae smokescreen speakeasy
Length 24: alliance archbishop balm bonnet brute centipede cobol covariate departure deploy diophantine efferent elysee exorcism filmy gestapo infra markham mincemeat moresby mycenae plugging smokescreen speakeasy
Length 25: alliance archbishop balm bonnet brute centipede cobol covariate departure deploy diophantine eradicate exorcism fiat filmy flatworm infra isis lindholm markham mincemeat moresby mycenae plugging speakeasy
Length 26: alliance archbishop balm bonnet brute centipede cobol covariate departure deploy diophantine elysee eradicate escritoire exorcism fiat filmy gestapo infra isis markham mincemeat mycenae plugging speakeasy vein
Length 27: alliance archbishop balm bonnet brute centipede covariate departure deploy efferent elysee eradicate escritoire exorcism fiat filmy flatworm infra isis lindholm markham mincemeat moresby mycenae plugging smokescreen speakeasy

PicoLisp

<lang PicoLisp>(de *Words 

  (alliance . -624) (archbishop . -915) (balm . 397) (bonnet . 452)
  (brute . 870) (centipede . -658) (cobol . 362) (covariate . 590)
  (departure . 952) (deploy . 44) (diophantine . 645) (efferent . 54)
  (elysee . -326) (eradicate . 376) (escritoire . 856) (exorcism . -983)
  (fiat . 170) (filmy . -874) (flatworm . 503) (gestapo . 915)
  (infra . -847) (isis . -982) (lindholm . 999) (markham . 475)
  (mincemeat . -880) (moresby . 756) (mycenae . 183) (plugging . -266)
  (smokescreen . 423) (speakeasy . -745) (vein . 813) )</lang>

Minimal brute force solution: <lang PicoLisp>(load "@lib/simul.l") # For 'subsets'

(pick 

  '((N)
     (find '((L) (=0 (sum cdr L)))
        (subsets N *Words) ) )
  (range 1 (length *Words)) )</lang>
Output:
-> ((archbishop . -915) (gestapo . 915))

Python

Version 1

<lang python>words = { # some values are different from example "alliance": -624, "archbishop": -925, "balm": 397, "bonnet": 452, "brute": 870, "centipede": -658, "cobol": 362, "covariate": 590, "departure": 952, "deploy": 44, "diophantine": 645, "efferent": 54, "elysee": -326, "eradicate": 376, "escritoire": 856, "exorcism": -983, "fiat": 170, "filmy": -874, "flatworm": 503, "gestapo": 915, "infra": -847, "isis": -982, "lindholm": 999, "markham": 475, "mincemeat": -880, "moresby": 756, "mycenae": 183, "plugging": -266, "smokescreen": 423, "speakeasy": -745, "vein": 813 }

neg = 0 pos = 0 for (w,v) in words.iteritems(): if v > 0: pos += v else: neg += v

sums = [0] * (pos - neg + 1)

for (w,v) in words.iteritems(): s = sums[:] if not s[v - neg]: s[v - neg] = (w,)

for (i, w2) in enumerate(sums): if w2 and not s[i + v]: s[i + v] = w2 + (w,)

sums = s if s[-neg]: for x in s[-neg]: print(x, words[x]) break</lang>

Output:


('mycenae', 183)
('speakeasy', -745)
('bonnet', 452)
('lindholm', 999)
('cobol', 362)
('archbishop', -925)
('elysee', -326)

Brute force

<lang python>>>> from itertools import combinations >>> >>> word2weight = {"alliance": -624, "archbishop": -915, "balm": 397, "bonnet": 452, 

 "brute": 870, "centipede": -658, "cobol": 362, "covariate": 590,
 "departure": 952, "deploy": 44, "diophantine": 645, "efferent": 54,
 "elysee": -326, "eradicate": 376, "escritoire": 856, "exorcism": -983,
 "fiat": 170, "filmy": -874, "flatworm": 503, "gestapo": 915,
 "infra": -847, "isis": -982, "lindholm": 999, "markham": 475,
 "mincemeat": -880, "moresby": 756, "mycenae": 183, "plugging": -266,
 "smokescreen": 423, "speakeasy": -745, "vein": 813}

>>> answer = None >>> for r in range(1, len(word2weight)+1): if not answer: for comb in combinations(word2weight, r): if sum(word2weight[w] for w in comb) == 0: answer = [(w, word2weight[w]) for w in comb] break


>>> answer [('archbishop', -915), ('gestapo', 915)]</lang>

Racket

<lang racket>

  1. lang racket

(define words 

 '([alliance -624] [archbishop -915] [balm 397] [bonnet 452] [brute 870]
   [centipede -658] [cobol 362] [covariate 590] [departure 952] [deploy 44]
   [diophantine 645] [efferent 54] [elysee -326] [eradicate 376]
   [escritoire 856] [exorcism -983] [fiat 170] [filmy -874] [flatworm 503]
   [gestapo 915] [infra -847] [isis -982] [lindholm 999] [markham 475]
   [mincemeat -880] [moresby 756] [mycenae 183] [plugging -266]
   [smokescreen 423] [speakeasy -745] [vein 813]))
Simple brute-force solution to find the smallest subset

(define (nsubsets l n) 

 (cond [(zero? n) '(())] [(null? l) '()]
       [else (append (for/list ([l2 (nsubsets (cdr l) (- n 1))])
                       (cons (car l) l2))
                     (nsubsets (cdr l) n))]))

(for*/first ([i (sub1 (length words))] [s (nsubsets words (add1 i))] 

            #:when (zero? (apply + (map cadr s))))
 (map car s))
=> '(archbishop gestapo)
Alternative
customize the subsets to ones with zero sum, abort early
if we're in a hopeless case (using the fact that weights are <1000)

(define (zero-subsets l) 

 (define (loop l len n r sum)
   (cond [(zero? n) (when (zero? sum) (displayln (reverse r)))]
         [(and (pair? l) (<= sum (* 1000 n)))
          (when (< n len) (loop (cdr l) (sub1 len) n r sum))
          (loop (cdr l) (sub1 len) (sub1 n) (cons (caar l) r)
                (+ (cadar l) sum))]))
 (define len (length l))
 (for ([i (sub1 len)]) (loop l len (add1 i) '() 0)))

(zero-subsets words) </lang>

Output:
'(archbishop gestapo) ; <- the first solution
(archbishop gestapo)
(exorcism fiat vein)
(centipede markham mycenae)
... 43M of printouts ...
(alliance archbishop balm bonnet brute centipede covariate departure deploy efferent elysee eradicate escritoire exorcism fiat filmy flatworm infra isis lindholm markham mincemeat moresby mycenae plugging smokescreen speakeasy)

REXX

This REXX solution isn't limited to integers for the weights.     This isn't a brute force solution.

While optimizing the original program, it was found that sorting the names by weight could yield a vastly
improved algorithm (by an order of magnitude), so the extra code to sort the list was included, as well as
another sort to show the solutions in alphabetical order.   Support was also added to allow specification of
which "chunk" to search for solutions (that is, out of the 31 names, take a "chunk" at a time).

Showing of the timing (elapsed time) was also added, as well as "que pasa" informational messages.   The
sum   (which is zero for this task) can be any number, and can be specifiable on the command line. <lang rexx>/*REXX pgm finds some non-null subsets of a weighted list whose sum=zero*/ parse arg target stopAt chunkette . /*get args from the command line*/ if target==|target==',' then target=0 /*TARGET given? No, use default*/ if stopAt==|stopAt==',' then stopAt=1 /*Max solutions? " " " */

zzz = 'alliance -624 archbishop -915 balm 397' , 

     'bonnet     452         brute        870         centipede  -658'  ,
     'cobol      362         covariate    590         departure   952'  ,
     'deploy      44         diophantine  645         efferent     54'  ,
     'elysee    -326         eradicate    376         escritoire  856'  ,
     'exorcism  -983         fiat         170         filmy      -874'  ,
     'flatworm   503         gestapo      915         infra      -847'  ,
     'isis      -982         lindholm     999         markham     475'  ,
     'mincemeat -880         moresby      756         mycenae     183'  ,
     'plugging  -266         smokescreen  423         speakeasy  -745'  ,
     'vein       813'

@.=0; y=0; do N=1 until zzz= /*build an array from a list. */ 

              parse var zzz @.N #.N zzz  /*pick from list like a nose. */
              end   /*N*/

call esort N /*sort the names with weights.*/ call tellZ 'sorted' /*show the sorted list. */ chunkStart=1 /*the default place to start. */ chunkEnd =N /* " " " " end. */ if chunkette\== then do /*solutions just for chunkette*/ 

                      chunkStart=chunkette
                      chunkEnd  =chunkette
                      end

call time 'Reset' /*reset the REXX elapsed time.*/ ??=0 /*number of solutions so far. */ 

  do chunk=chunkStart  to chunkEnd       /*traipse through the items.  */
  call tello center(' doing chunk:' chunk" ",79,'─')
  call combN N, chunk                    /*N items, a CHUNK at a time. */
  _=??;         if _==0  then _='No'     /*Englishise for a zero count.*/
  call tello _ 'solution's(??) "found so far  and  took",
                           format(time('Elapsed'),,2) 'seconds so far.',.
  end   /*chunk*/

if ??==0 then ??='no' /*Englishise solutions number.*/ call tello 'Found' ?? "subset"s(??) 'whose summed weight's(??) "=" target exit /*stick a fork in it, we done.*/ /*──────────────────────────────────COMBN subroutine────────────────────*/ combN: procedure expose @. #. ?? stopAt target; parse arg x,y;  !.=0 base=x+1; bbase=base-y; ym=y-1 /*!.n are the combination digits*/ 

        do n=1  for y;  !.n=n;  end   /*build the first combination.   */

  do j=1;   _=!.1;  s=#._             /*get the first digit and the sum*/
  if s>target then leave              /*1st dig>target? Then we're done*/

     do k=2  for ym;  _=!.k;  s=s+#._ /*Σ the weights; is sum > target?*/
     if s>target then do;   if .combUp(k-1) then return;  iterate j;  end
     end   /*k*/

  if s==target  then call telly       /*have we found a pot of gold?   */
  !.y=!.y+1;    if !.y==base then if .combUp(ym) then leave  /*bump dig*/
  end      /*j*/

return /*done with this combination set.*/

.combUp: procedure expose !. y bbase; parse arg d; if d==0 then return 1 p=!.d; do u=d to y;  !.u=p+1 /*add 1 to dig we're pointing at.*/ 

            if !.u>=bbase+u  then return .combUp(u-1)
            p=!.u                     /*P will be used for the next dig*/
            end   /*u*/

return 0 /*go back & sum this combination.*/ /*──────────────────────────────────ESORT subroutine────────────────────*/ esort: procedure expose #. @. $.; parse arg N,$; h=N 

      do  while h>1;        h=h%2
        do i=1 for  N-h;    j=i;        k=h+i
        if $==.  then do while $.k<$.j; parse value $.j $.k with $.k $.j
                      if h>=j  then leave;    j=j-h;        k=k-h
                      end   /*while $.k<$.j*/
                 else do while #.k<#.j; parse value @.j @.k #.j #.k with @.k @.j #.k #.j
                      if h>=j  then leave;    j=j-h;        k=k-h
                      end   /*while #.k<#.j*/
        end   /*i*/
      end     /*while h>1*/

return /*──────────────────────────────────one─liner subroutines─────────────────────*/ s: if arg(1)==1 then return arg(3); return word(arg(2) 's',1) /*plural*/ tello: parse arg _,e; if e==. then say; say _; call lineout 'SUBSET.'y,_; return /*──────────────────────────────────TELLY subroutine────────────────────*/ telly: ??=??+1; nameL= /*start with a "null" name list. */ 

              do gi=1 for y; ggg=!.gi /*build dup array (to be sorted).*/
              $.gi=@.ggg              /*transform from index──► a name.*/
              end   /*gi*/            /*build dup array (to be sorted).*/

call eSort y,. /*sort the names alphabetically. */ 

    do gs=1  for y;  nameL=nameL $.gs /*build list of names whose sum=0*/
    end   /*gs*/                      /*list of names could be sorted  */

call tello '['y" name"s(y)']' space(nameL) if ??<stopAt | stopAt==0 then return /*see if we reached a (the) limit*/ call tello 'Stopped after finding '  ?? " subset"s(??)'.',. exit /*a short─timer, we have to quit.*/ /*──────────────────────────────────TELLZ subroutine────────────────────*/ tellz: do j=1 for N /*show list of names and weights.*/ 

          call tello  right('['j']',30)    right(@.j,11)    right(#.j,5)
          end   /*j*/

call tello call tello 'There are ' N " entries in the (above)" arg(1) 'table.' call tello; return</lang> Output note:   this program also writes the displayed output to file(s):   SUBSET.nnn
──────── where   nnn   is the chunk number.

Output:

when using the input of

  0 12

(The above arguments set the target sum to zero and limits finding of a dozen solutions.) 

                           [1]    exorcism  -983
                           [2]        isis  -982
                           [3]  archbishop  -915
                           [4]   mincemeat  -880
                           [5]       filmy  -874
                           [6]       infra  -847
                           [7]   speakeasy  -745
                           [8]   centipede  -658
                           [9]    alliance  -624
                          [10]      elysee  -326
                          [11]    plugging  -266
                          [12]      deploy    44
                          [13]    efferent    54
                          [14]        fiat   170
                          [15]     mycenae   183
                          [16]       cobol   362
                          [17]   eradicate   376
                          [18]        balm   397
                          [19] smokescreen   423
                          [20]      bonnet   452
                          [21]     markham   475
                          [22]    flatworm   503
                          [23]   covariate   590
                          [24] diophantine   645
                          [25]     moresby   756
                          [26]        vein   813
                          [27]  escritoire   856
                          [28]       brute   870
                          [29]     gestapo   915
                          [30]   departure   952
                          [31]    lindholm   999

There are  31  entries in the (above) sorted table.

─────────────────────────────── doing chunk: 1 ────────────────────────────────

No solutions found so far  and  took 0.00 seconds so far.
─────────────────────────────── doing chunk: 2 ────────────────────────────────
[2 names] archbishop gestapo

1 solution found so far  and  took 0.01 seconds so far.
─────────────────────────────── doing chunk: 3 ────────────────────────────────
[3 names] exorcism fiat vein
[3 names] centipede markham mycenae

3 solutions found so far  and  took 0.06 seconds so far.
─────────────────────────────── doing chunk: 4 ────────────────────────────────
[4 names] exorcism gestapo speakeasy vein
[4 names] deploy exorcism moresby mycenae
[4 names] bonnet elysee escritoire isis
[4 names] eradicate isis mycenae smokescreen
[4 names] balm efferent filmy smokescreen
[4 names] centipede covariate gestapo infra
[4 names] centipede covariate speakeasy vein
[4 names] brute centipede efferent plugging
[4 names] alliance balm deploy mycenae

Stopped after finding  12  subsets.

Ruby

a brute force solution: <lang ruby>weights = { 

 'alliance'   =>-624, 'archbishop'=>-915, 'balm'       => 397, 'bonnet'   => 452,
 'brute'      => 870, 'centipede' =>-658, 'cobol'      => 362, 'covariate'=> 590,
 'departure'  => 952, 'deploy'    =>  44, 'diophantine'=> 645, 'efferent' =>  54,
 'elysee'     =>-326, 'eradicate' => 376, 'escritoire' => 856, 'exorcism' =>-983,
 'fiat'       => 170, 'filmy'     =>-874, 'flatworm'   => 503, 'gestapo'  => 915,
 'infra'      =>-847, 'isis'      =>-982, 'lindholm'   => 999, 'markham'  => 475,
 'mincemeat'  =>-880, 'moresby'   => 756, 'mycenae'    => 183, 'plugging' =>-266,
 'smokescreen'=> 423, 'speakeasy' =>-745, 'vein'       => 813,

}

words = weights.keys 1.upto(words.length) do |n| 

 zerosum = words.combination(n).find do |subset|
   subset.reduce(0) {|sum, word| sum + weights[word]} == 0
 end
 
 if zerosum
   puts "a subset of length #{n} that sums to zero: #{zerosum}"
 else
   puts "no subsets of length #{n} sum to zero"
 end

end</lang>

Output:
no subsets of length 1 sum to zero
a subset of length 2 that sums to zero: ["archbishop", "gestapo"]
a subset of length 3 that sums to zero: ["centipede", "markham", "mycenae"]
a subset of length 4 that sums to zero: ["alliance", "balm", "deploy", "mycenae"]
a subset of length 5 that sums to zero: ["alliance", "brute", "covariate", "deploy", "mincemeat"]
a subset of length 6 that sums to zero: ["alliance", "archbishop", "balm", "deploy", "gestapo", "mycenae"]
a subset of length 7 that sums to zero: ["alliance", "archbishop", "bonnet", "cobol", "departure", "exorcism", "moresby"]
a subset of length 8 that sums to zero: ["alliance", "archbishop", "balm", "bonnet", "fiat", "flatworm", "isis", "lindholm"]
a subset of length 9 that sums to zero: ["alliance", "archbishop", "balm", "bonnet", "brute", "covariate", "eradicate", "mincemeat", "plugging"]
a subset of length 10 that sums to zero: ["alliance", "archbishop", "balm", "bonnet", "brute", "centipede", "cobol", "departure", "deploy", "mincemeat"]
a subset of length 11 that sums to zero: ["alliance", "archbishop", "balm", "bonnet", "brute", "centipede", "cobol", "departure", "infra", "moresby", "speakeasy"]
a subset of length 12 that sums to zero: ["alliance", "archbishop", "balm", "bonnet", "brute", "centipede", "cobol", "covariate", "diophantine", "efferent", "elysee", "infra"]
a subset of length 13 that sums to zero: ["alliance", "archbishop", "balm", "bonnet", "brute", "centipede", "cobol", "covariate", "departure", "efferent", "eradicate", "filmy", "isis"]
a subset of length 14 that sums to zero: ["alliance", "archbishop", "balm", "bonnet", "brute", "centipede", "cobol", "covariate", "departure", "deploy", "elysee", "filmy", "markham", "speakeasy"]
a subset of length 15 that sums to zero: ["alliance", "archbishop", "balm", "bonnet", "brute", "centipede", "cobol", "covariate", "departure", "deploy", "elysee", "exorcism", "flatworm", "infra", "mycenae"]
a subset of length 16 that sums to zero: ["alliance", "archbishop", "balm", "bonnet", "brute", "centipede", "cobol", "covariate", "departure", "deploy", "diophantine", "elysee", "exorcism", "filmy", "gestapo", "infra"]
a subset of length 17 that sums to zero: ["alliance", "archbishop", "balm", "bonnet", "brute", "centipede", "cobol", "covariate", "departure", "deploy", "diophantine", "exorcism", "isis", "mincemeat", "mycenae", "plugging", "vein"]
a subset of length 18 that sums to zero: ["alliance", "archbishop", "balm", "bonnet", "brute", "centipede", "cobol", "covariate", "departure", "deploy", "diophantine", "efferent", "elysee", "exorcism", "filmy", "isis", "mycenae", "vein"]
a subset of length 19 that sums to zero: ["alliance", "archbishop", "balm", "bonnet", "brute", "centipede", "cobol", "covariate", "departure", "deploy", "diophantine", "efferent", "elysee", "eradicate", "exorcism", "fiat", "infra", "isis", "smokescreen"]
a subset of length 20 that sums to zero: ["alliance", "archbishop", "balm", "bonnet", "brute", "centipede", "cobol", "covariate", "departure", "deploy", "diophantine", "efferent", "elysee", "eradicate", "exorcism", "gestapo", "infra", "isis", "smokescreen", "speakeasy"]
a subset of length 21 that sums to zero: ["alliance", "archbishop", "balm", "bonnet", "brute", "centipede", "cobol", "covariate", "departure", "deploy", "diophantine", "efferent", "elysee", "eradicate", "exorcism", "flatworm", "infra", "lindholm", "mincemeat", "plugging", "speakeasy"]
a subset of length 22 that sums to zero: ["alliance", "archbishop", "balm", "bonnet", "brute", "centipede", "cobol", "covariate", "departure", "deploy", "diophantine", "efferent", "elysee", "eradicate", "escritoire", "exorcism", "fiat", "filmy", "flatworm", "mincemeat", "plugging", "speakeasy"]
a subset of length 23 that sums to zero: ["alliance", "archbishop", "balm", "bonnet", "brute", "centipede", "cobol", "covariate", "departure", "deploy", "diophantine", "efferent", "elysee", "eradicate", "escritoire", "exorcism", "infra", "isis", "mincemeat", "moresby", "mycenae", "smokescreen", "speakeasy"]
a subset of length 24 that sums to zero: ["alliance", "archbishop", "balm", "bonnet", "brute", "centipede", "cobol", "covariate", "departure", "deploy", "diophantine", "efferent", "elysee", "exorcism", "filmy", "gestapo", "infra", "markham", "mincemeat", "moresby", "mycenae", "plugging", "smokescreen", "speakeasy"]
a subset of length 25 that sums to zero: ["alliance", "archbishop", "balm", "bonnet", "brute", "centipede", "cobol", "covariate", "departure", "deploy", "diophantine", "eradicate", "exorcism", "fiat", "filmy", "flatworm", "infra", "isis", "lindholm", "markham", "mincemeat", "moresby", "mycenae", "plugging", "speakeasy"]
a subset of length 26 that sums to zero: ["alliance", "archbishop", "balm", "bonnet", "brute", "centipede", "cobol", "covariate", "departure", "deploy", "diophantine", "elysee", "eradicate", "escritoire", "exorcism", "fiat", "filmy", "gestapo", "infra", "isis", "markham", "mincemeat", "mycenae", "plugging", "speakeasy", "vein"]
a subset of length 27 that sums to zero: ["alliance", "archbishop", "balm", "bonnet", "brute", "centipede", "covariate", "departure", "deploy", "efferent", "elysee", "eradicate", "escritoire", "exorcism", "fiat", "filmy", "flatworm", "infra", "isis", "lindholm", "markham", "mincemeat", "moresby", "mycenae", "plugging", "smokescreen", "speakeasy"]
no subsets of length 28 sum to zero
no subsets of length 29 sum to zero
no subsets of length 30 sum to zero
no subsets of length 31 sum to zero

Tcl

As it turns out that the problem space has small subsets that sum to zero, it is more efficient to enumerate subsets in order of their size rather than doing a simple combination search. This is not true of all possible input data sets though; the problem is known to be NP-complete after all. <lang tcl>proc subsetsOfSize {set size} { 

   if {$size <= 0} {

return 

   } elseif {$size == 1} {

foreach elem $set {lappend result [list $elem]} 

   } else {

incr size [set i -1] foreach elem $set { foreach sub [subsetsOfSize [lreplace $set [incr i] $i] $size] { lappend result [lappend sub $elem] } } 

   }
   return $result

} proc searchForSubset {wordweights {minsize 1}} { 

   set words [dict keys $wordweights]
   for {set i $minsize} {$i < [llength $words]} {incr i} {

foreach subset [subsetsOfSize $words $i] { set w 0 foreach elem $subset {incr w [dict get $wordweights $elem]} if {!$w} {return $subset} } 

   }
   # Nothing was found
   return -code error "no subset sums to zero"

}</lang> Demonstrating: <lang tcl>set wordweights { 

   alliance	 -624
   archbishop	 -915
   balm	 397
   bonnet	 452
   brute	 870
   centipede	 -658
   cobol	 362
   covariate	 590
   departure	 952
   deploy	 44
   diophantine	 645
   efferent	 54
   elysee	 -326
   eradicate	 376
   escritoire	 856
   exorcism	 -983
   fiat	 170
   filmy	 -874
   flatworm	 503
   gestapo	 915
   infra	 -847
   isis	 -982
   lindholm	 999
   markham	 475
   mincemeat	 -880
   moresby	 756
   mycenae	 183
   plugging	 -266
   smokescreen	 423
   speakeasy	 -745
   vein	 813

} set zsss [searchForSubset $wordweights] puts "Found zero-summing subset: [join [lsort $zsss] {, }]"</lang>

Output:
Found zero-summing subset: archbishop, gestapo

Ursala

This solution scans the set sequentially while maintaining a record of all distinct sums obtainable by words encountered thus far, and stops when a zero sum is found. <lang Ursala>#import std

  1. import int

weights =

{ 

  'alliance': -624,
  'archbishop': -915,
  'balm': 397,
  'bonnet': 452,
  'brute': 870,
  'centipede': -658,
  'cobol': 362,
  'covariate': 590,
  'departure': 952,
  'deploy': 44,
  'diophantine': 645,
  'efferent': 54,
  'elysee': -326,
  'eradicate': 376,
  'escritoire': 856,
  'exorcism': -983,
  'fiat': 170,
  'filmy': -874,
  'flatworm': 503,
  'gestapo': 915,
  'infra': -847,
  'isis': -982,
  'lindholm': 999,
  'markham': 475,
  'mincemeat': -880,
  'moresby': 756,
  'mycenae': 183,
  'plugging': -266,
  'smokescreen': 423,
  'speakeasy': -745,
  'vein': 813}

nullset = ~&nZFihmPB+ =><> ~&ng?r\~&r ^TnK2hS\~&r ^C/~&lmPlNCX *D ^A/sum@lmPrnPX ~&lrmPC

  1. cast %zm

main = nullset weights</lang> The name of the function that takes the weighted set is nullset. It manipulates a partial result represented as a list of pairs, each containing a subset of weighted words and the sum of their weights. Here is a rough translation:

  • =><> fold right combinator with the empty list as the vacuuous case
  • ~&ng?r\~&r If the partial result contains a zero sum, return it.
  • ^TnK2hS\~&r Concatenate the partial result with the new list of subsets (computed as follows) and delete duplicate sums.
  • ^C/~&lmPlNCX Cons a singleton subset containing the next word to the partial results.
  • *D Distribute the next word in the set to the partial results and do the following to each.
  • sum@lmPrnPX Add the weight of the new word to the existing sum.
  • ~&lrmPC Cons the new word to the list of existing ones.
  • ~&nZFihmPB+ To conclude, search for a result with a zero sum, if any, and return its associated subset of weighted words.
Output:
<
   'flatworm': 503,
   'gestapo': 915,
   'infra': -847,
   'isis': -982,
   'lindholm': 999,
   'plugging': -266,
   'smokescreen': 423,
   'speakeasy': -745>
Retrieved from "https://rosettacode.org/wiki/Subset_sum_problem?oldid=210638"