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?
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others wandering the Monastery: (6)
As of 2018-06-22 02:32 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?
Should cpanminus be part of the standard Perl release?

Results (121 votes). Check out past polls.

Notices?