Perl Weekly Challenge 124: Tug of War

by Abigail

Challenge

You are given a set of $n integers (n1, n2, n3, ….).

Write a script to divide the set in two subsets of n/2 sizes each so that the difference of the sum of two subsets is the least. If $n is even then each subset must be of size $n/2 each. In case $n is odd then one subset must be ($n-1)/2 and other must be ($n+1)/2.

Example

Input:        Set = (10, 20, 30, 40, 50, 60, 70, 80, 90, 100)
Output:  Subset 1 = (30, 40, 60, 70, 80)
         Subset 2 = (10, 20, 50, 90, 100)

Input:        Set = (10, -15, 20, 30, -25, 0, 5, 40, -5)
Output:  Subset 1 = (30, 0, 5, -5)
         Subset 2 = (10, -15, 20, -25, 40)

Solution

Perl

First, we present a method which gets two sets, finds the difference in their sums, and records them if they have a smaller difference than we've seen before:

use List::Util qw [sum0];

my $best_diff = ~0;  # Max int
my @best_set1;
my @best_set2;

sub check_sets ($set1, $set2) {
    my $diff = abs (sum (@$set1) - sum (@$set2));
    if ($diff < $best_diff) {
        $best_diff = $diff;
        @best_set1 = @$set1;
        @best_set2 = @$set2;
    }
}

Next we present a function to split a set into two equal parts. It gets four arguments: set which contains the elements of the input set which we have to assigned to a subset yet; set1, and set2, the sets we are splitting into; and callback, the method we call when we're done splitting the set.

If set1 or set2 are the required size, we assign the rest of set to the other subset and call callback.

Otherwise, we take the first element of set, and add it to set1 and set2 respectively, recursing in each case:

use POSIX qw [floor ceil];
sub split_set ($set, $set1, $set2, $callback) {
    my $n = @$set + @$set1 + @$set2;

    if (@$set1 == floor ($n / 2)) {
        $callback -> ($set1, [@$set2, @$set]);
    }
    elsif (@$set2 == ceil ($n / 2)) {
        $callback -> ([@$set1, @$set], $set2);
    }
    else {
        my $element = $$set [0];
        split_set ([@$set [1 .. $#$set]], [@$set1, $element], $set2, $callback);
        split_set ([@$set [1 .. $#$set]], $set1, [@$set2, $element], $callback);
    }
}

With the input (space separated numbers) in $_, we can call this as:

split_set ([split], [], [], \&check_sets);

Printing the result is now easy:

say "@best_set1; @best_set2";

Find the full program on GitHub.