Re: partition of an array

[rir]

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.

Be well,
rir

!/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;
    };
}