http://qs1969.pair.com?node_id=180542


in reply to Puzzle: need a more general algorithm

I was sent the following answer to the puzzle with the following challenge:

If you think you know who sent this, please do not speculate! I will neither confirm nor deny ...

use strict; use Carp; use Data::Dumper; $Data::Dumper::Indent = 1; print Dumper [group_cats(3, 1..7)]; { my @sizes; my %ans; sub group_cats { (my $num, @sizes) = @_; %ans = (); my ($size, @partition) = _group_cats($num, 0, $#sizes); return @partition; } sub _group_cats { my $key = join ":", @_; my ($num, $start, $end) = @_; if (not exists $ans{$key}) { if ($num < 1) { $ans{$key} = [0]; } elsif (1 == $num) { my @part = map $sizes[$_], $start..$end; $ans{$key} = [sum(@part), \@part]; } else { my $num_a = int($num/2); my $num_b = $num - $num_a; my $min_mid = $start + $num_a - 1; my $max_mid = $end - $num_b; my $mid = int(($min_mid + $max_mid)/2); my ($last_a, @part_a) = _group_cats($num_a, $start, $mid); my ($last_b, @part_b) = _group_cats($num_b, $mid + 1, $end); my $best = max($last_a, $last_b); my @best_part = (@part_a, @part_b); while ($min_mid < $max_mid) { if ($last_a <= $last_b) { if ($min_mid < $mid) { $min_mid = $mid; } else { $min_mid = $mid + 1; } } else { $max_mid = $mid; } $mid = int(($min_mid + $max_mid)/2); ($last_a, @part_a) = _group_cats($num_a, $start, $mid); ($last_b, @part_b) = _group_cats($num_b, $mid + 1, $end); if (max($last_a, $last_b) < $best) { $best = max($last_a, $last_b); @best_part = (@part_a, @part_b); } } $ans{$key} = [$best, @best_part]; } } return @{$ans{$key}}; } } sub max { my $max = shift; for (@_) { $max = $_ if $max < $_; } $max; } sub sum { my $sum = 0; $sum += $_ for @_; return $sum; }

Cheers,
Ovid

Join the Perlmonks Setiathome Group or just click on the the link and check out our stats.

Replies are listed 'Best First'.
Re: Puzzle for the puzzle: Re: Puzzle...
by Anonymous Monk on Jul 09, 2002 at 23:36 UTC
    And here is an optimized version. Add in the question of what optimizations are present, and why they work. Some are more obvious than others. The thoughtful hacker might also wonder at why the $max_mid, $min_mid logic switched.

    Oh right. And this adds the restriction that the heights should be integers. I think that is a reasonable rule for the speedup...

    use strict; { use integer; my @sizes; my %ans; my @align; sub group_cats { (my $num, @sizes) = @_; %ans = (); my $a = 1; for my $i (1..$#sizes) { if ($a + $a < $i) { $a += $a; } $align[$i] = $a; } $align[0] = 0; my ($size, @partition) = _group_cats($num, 0, $#sizes); return @partition; } sub _group_cats { my $key = join ":", @_; my ($num, $start, $end) = @_; if (not exists $ans{$key}) { if ($num < 1) { $ans{$key} = [0]; } elsif (1 == $num) { my @part = @sizes[$start..$end]; my $sum = 0; $sum += $_ for @part; $ans{$key} = [$sum, \@part]; } else { my $num_a = $align[$num]; my $num_b = $num - $num_a; my $min_mid = $start + $num_a - 1; my $max_mid = $end - $num_b; my $mid = $min_mid + $align[$max_mid - $min_mid]; my ($last_a, @part_a) = _group_cats($num_a, $start, $mid); my ($last_b, @part_b) = _group_cats($num_b, $mid + 1, $end); my $best = $last_a < $last_b ? $last_b : $last_a; my @best_part = (@part_a, @part_b); while ($min_mid < $max_mid) { if ($last_b <= $last_a) { if ($max_mid > $mid) { $max_mid = $mid; } else { $max_mid--; } } else { $min_mid = $mid; } $mid = $min_mid + $align[$max_mid - $min_mid]; ($last_a, @part_a) = _group_cats($num_a, $start, $mid); ($last_b, @part_b) = _group_cats($num_b, $mid + 1, $end); my $max = $last_a < $last_b ? $last_b : $last_a; if ($max < $best) { $best = $max; @best_part = (@part_a, @part_b); } } $ans{$key} = [$best, @best_part]; } } return @{$ans{$key}}; } }
    BTW the original question had an straightforward recursive solution that scaled exponentially. I found that too easy, hence the faster solution.