When I realized that this wasn't going to be quick and easy,
I decided that having a brute force implementation upon which to compare was necessary. Now, I think there is nothing better than to take a drink and a long walk.
It doesn't seem that anyone has provided a correct solution.
I believe this is one.
!/usr/bin/perl
use warnings;
use strict;
use List::Util qw/ sum /;
local $, = ' ';
my @ar = (
[qw{ 2 } ],
[qw{ -1 2 } ],
[qw{ -1 2 -4 }],
[qw{ 90 -120 -10 -1 1 5 25 80 }],
[qw{ 9 2 -4 }],
[qw{ 9 1 6 3 }],
[qw{ 1 2 3 4 5 6 }],
[qw{ 1 1 2 3 4 5 6 }],
[qw{ 1 2 3 4 5 9 10 }],
[qw{ 1 1 1 2 2 2 2 4 }],
[qw{ 9 1 1 1 1 1 1 1 1 1 }],
[qw{ 7 7 7 1 0 0 0 -42 0 0 6 6 6 }],
[qw{ 7 7 7 1 0 0 0 -42 0 0 6 6 6 -28 }],
);
for my $in (@ar) {
my ( $score, $hd, $tl ) = halves_w_closest_totals($in);
no warnings 'uninitialized';
print "brute: $score [ @$in[@$hd]] [ @$in[@$tl]] $/";
}
exit;
# return score, half_input_aref, other_half_input_aref
sub halves_w_closest_totals {
my $ar = shift;
return ( 0, [], [] ) unless @$ar;
return ( 0, [], [ $ar[0] ] ) if 1 == @$ar;
return ( 0, [ $$ar[0] ], [ $$ar[1] ] ) if 2 == @$ar;
my $best_yet;
my $diff;
my @perm;
my $iter = halves(@$ar);
while ( @perm = $iter->() ) {
my ( $h, $t ) = @perm;
my @tot = sort { $a <=> $b } ( sum( @$ar[@$h] ), sum( @$ar[@$t
+] ) );
$diff = abs( $tot[0] - $tot[1] );
if ( not defined $best_yet->[0]
or $best_yet->[0] > $diff )
{
$best_yet->[0] = $diff;
@$best_yet[ 1, 2 ] = ( $h, $t );
last if 1 >= $best_yet->[0]; # if 1 then 0 not possible
}
}
return ( $best_yet->[0], $best_yet->[1], $best_yet->[2] );
}
# Return an Iter to yield all the unique halves of an array.
# Mirror image results are not generated.
# The Iter deals in/manipulates indices into the array input.
sub halves {
my @in = @_;
my @return; # stack of answers
my $done = 0;
my $lsize = int @in / 2; # left half size
my @lv = ( 0 .. $lsize - 1 ); # left current value
my @lul; # left upper limits
# set upper bounds for answer for even-sized or odd-sized input
@lul = (0 == @in % 2) ? ( 0, $lsize+1 .. $#in) : ( $lsize+1 .. $#i
+n);
my $curs = @lv - 1;
return sub {
return shift @return, shift @return if @return;
return if $done;
return unless @in;
if ( 1 == @in ) {
++$done;
return [], [ $in[0] ];
}
# larger inputs
local $_;
while (1) {
#die "cursor s/b on lsd" unless $curs == $#lul;
# Use the list of head indices to make a list of
# tail indices and return two arefs
my @ret_tail_idx = ( 0 .. $#in );
splice @ret_tail_idx, $_, 1 for reverse @lv;
push @return, [@lv], [ @ret_tail_idx ];
# turn the counting gears
if ( $lv[$curs] == $lul[$curs] ) {
while ( $lv[$curs] >= $lul[$curs] && $curs > -1 ) {
# Move to left while elem's are at max
--$curs;
}
if ( $curs == -1 ) {
# All elements are at upper limit.
++$done;
last;
}
else {
# Found an elem that can be increased.
# Increase it, and set elem's to the
# right by counting up, x, x+1, x+2, ... x+n.
++$lv[$curs];
while ( $curs < $lsize - 1 ) {
++$curs;
$lv[$curs] = $lv[ $curs - 1 ] + 1;
}
--$lv[$curs]; # crank backward one
}
}
++$lv[$curs]; # turn crank forward
return shift @return, shift @return if @return;
}
return shift @return, shift @return if @return;
};
}