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

Create A New User
Node Status?
node history
Node Type: note [id://751087]
help
Chatterbox?
 [planetscape]: boo

How do I use this? | Other CB clients
Other Users?
Others having an uproarious good time at the Monastery: (6)
As of 2018-04-27 09:38 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?
My travels bear the most uncanny semblance to ...

Results (97 votes). Check out past polls.

Notices?