We don't bite newbies here... much PerlMonks

### Re: Puzzle: need a more general algorithm

by lemming (Priest)
 on Jul 10, 2002 at 04:47 UTC ( #180675=note: print w/replies, xml ) Need Help??

in reply to Puzzle: need a more general algorithm

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 \$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} )) {
}
else {
\$height = sum(\$col_r);
}
\$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";
}

Replies are listed 'Best First'.
Re: Re: Puzzle: need a more general algorithm
by Anonymous Monk on Jul 10, 2002 at 12:35 UTC
Very good. Pre-memoization you are exponential. With memoization your memory usage scales like O(n**3), and your performance is O(n**4). If you passed the array by reference, and added 2 indices, you would drop a factor of n off of both.

By contrast the efficient algorithm is sub-exponential pre-memoization, and is sub-quadratic after.

Which shows that good algorithms are a big win, but being straightforward, and then applying well-known speedups to that, can still result in a usable algorithm.

Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://180675]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others chilling in the Monastery: (2)
As of 2023-03-22 18:15 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?
Which type of climate do you prefer to live in?

Results (60 votes). Check out past polls.

Notices?