Ok, this is that straight forward recursive method. By keeping track of the subsets we've already looked at, it's not too bad with the 50, 1-150 set.
Update: Pass data by reference as suggested. A couple other small changes. Added another indice for array totals.
#!/usr/bin/perl
use strict;
use warnings;
use constant DEBUG => 0;
# my $columns = 6;
# my @data = qw( 10 13 25 30 10 15 1 4 25);
my $columns = 50;
my @data = (1..150);
die "Not enough catagories for columns\n"
if $columns > @data;
our $mega_height = sum(\@data);
my %key_h; my %add_h;
my $best_r = get_best($columns, \%add_h, \%key_h, \@data);
printit($best_r);
exit;
sub get_best {
my ($columns, $add_r, $key_r, $data_r) = @_;
my $max_stack = @$data_r - $columns + 1;
my $max_height = $mega_height;
my $fed_key = join("-", @$data_r, $columns);
print "[", join(",", @$data_r),"]-",$columns,"\n" if DEBUG;
my $best_r;
foreach my $stack ( 1 .. $max_stack ) {
my @arr;
$arr[0] = [ @$data_r[0..$stack-1] ];
my $tmp_r;
if ($columns == 2) {
# We only have one more column to fill
push(@arr, [ @$data_r[$stack..@$data_r-1] ]);
}
elsif (@$data_r - $stack == $columns - 1 ) {
# One cat per column left
map push(@arr, [ $_ ]), @$data_r[$stack..@$data_r-1];
}
else {
my $key = join("-", @$data_r[$stack..@$data_r-1],
$columns - 1);
# See if we've done this before
if ( defined( $key_r->{$key} )) {
$tmp_r = $key_r->{$key};
}
else {
$tmp_r = get_best( $columns - 1, $add_r, $key_r,
[@$data_r[$stack..@$data_r-1]] );
}
push ( @arr, @$tmp_r );
}
my $cur_height = 0;
foreach my $col_r (@arr ) {
my $height;
my $ckey = join(",",@$col_r);
if ( defined( $add_r->{$ckey} )) {
$height = $add_r->{$ckey};
}
else {
$height = sum($col_r);
$add_r->{$ckey} = $height;
}
$cur_height = $height if $cur_height < $height;
}
printit(\@arr) if DEBUG;
if ( $cur_height < $max_height or !defined($best_r)) {
$best_r = \@arr;
$max_height = $cur_height;
}
}
$key_r->{$fed_key} = $best_r;
return $best_r;
}
sub sum {
my ($col_r) = @_;
my $height = 0;
foreach my $bit ( @$col_r ) {
$height += $bit;
}
return $height;
}
sub printit {
my ($arr_r) = @_;
my $start = 1;
my $max = 0;
foreach my $col_r (@$arr_r) {
print ", " unless $start;
$start = 0 if ( $start );
my $height = sum($col_r);
print "[ ", join(", ", @$col_r), " ]";
$max = $height if $height > $max;
}
print " => $max\n";
}