Beefy Boxes and Bandwidth Generously Provided by pair Networks Cowboy Neal with Hat
more useful options
 
PerlMonks  

Re: partition of an array

by rir (Vicar)
on Mar 17, 2009 at 02:20 UTC ( #751087=note: print w/ replies, xml ) Need Help??


in reply to partition of an array

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


Comment on Re: partition of an array
Download Code

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://751087]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others imbibing at the Monastery: (10)
As of 2014-04-17 08:46 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    April first is:







    Results (441 votes), past polls