Beefy Boxes and Bandwidth Generously Provided by pair Networks
Pathologically Eclectic Rubbish Lister
 
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 %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"; }


Comment on Re: Puzzle: need a more general algorithm
Download Code
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.

Log In?
Username:
Password:

What's my password?
Create A New User
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 surveying the Monastery: (5)
As of 2015-07-05 16:16 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (67 votes), past polls