Perl Weekly Challenge 371: Subset Equilibrium

Input:  2 1 4 3
Output: 2 1; 1 4; 4 3; 2 3;

Input:  3 0 3 0
Output: 3 0; 3 0 3;

Input:  5 1 1 1
Output: 5 1 1;

Input:  3 -1 4 2
Output: 3 2; 3 -1 4;

Input:  10 20 30 40
Output:

Note that the examples only work if we assume indices start at 1, which is not the way indices in Perl work.

The challenge looks very much like an NP complete problem. There doesn't seem to be a significant faster solution than just checking (almost) every power set of the input. Which works fine for tiny input sets of 4 elements (just 10 proper subsets with more than one element), but this rapidly grows. In general, for a set of \(N\) elements, there are \(2^N - N - 2\) proper subsets with more than one element. If we have 10 elements, there are already over 1,000 subsets to consider, and over a million subsets if we start with 20 elements.

We solve this challenge by iterating (mask) from \(1\) to \(2^N - 2\) (where \(N\) is the number of elements in the input). For each mask, we make a subset of elements whose position matches a 1-bit in the mask. If the sum of the elements matches the sum of the positions, we print the subset. We actually don't calculate the sums, instead for each element which gets added to the subset, we sum the difference between the element and its position — and check if we end up with 0.

Our input consists of lines (one line per input set), with the elements separated by whitespace. For each input set, we output a line with the subset; sets separated by a semi-colon, and elements by a space.

For the given examples, the input will be

2 1 4 3
3 0 3 0
5 1 1 1
3 -1 4 2
10 20 30 40

And the output will be

2 1; 1 4; 2 3; 4 3;
3 0; 3 0 3;
5 1 1;
3 -1 4; 3 2;

With a line of input in $_, we create an array of numbers:

my @numbers = split;

Looping over all the masks:

foreach my $mask (1 .. 2 ** @numbers - 2) { 
    my $sum = 0;
    my @set;
    ...
}

For each mask, we loop over the @numbers array, and if their position matches the mask, we add it to the set:

while (my ($index, $val) = each @numbers) {
   if ($mask & (1 << $index)) {
       $sum += $val - $index - 1;
       push @set => $val;
   }
}

If the sum equals 0, and we have more than one element in the set, we print it:

if ($sum == 0 && @set > 1) {
    print "@set; ";
}

Find the full program on GitHub.

for line in sys . stdin:
    numbers = list (map (lambda n: int (n), line . strip () . split (" ")))

    for mask in range (1, 2 ** (len (numbers)) - 1):
        sum = 0
        set = []
        for index, val in enumerate (numbers):
            if mask & (1 << index):
                sum = sum + val - index - 1
                set . append (val)
        if sum == 0 and len (set) > 1:
            print (" " . join (list (map (lambda i: str (i), set))) + "; ", \
                   end = '')
    print ("")