All,
I have been unable to find anything other than a brute-force method that always produces a correct answer. Feel free to use this to bench any new ideas against but all the existing ones in this thread are wrong. Please let me know if you discover a short cut.
When I first started learning perl, tye told me I had to stop thinking that less lines of code meant faster code. I think I learned this lesson well as the following brute force method is pretty fast but is definately not succinct. If you are interested in knowing how it works - let me know
The module:
package Max::Bins;
require List::Util;
@ISA = qw(Exporter);
@EXPORT = qw(avail progressive);
$VERSION = '0.01';
use strict;
use warnings;
my %sum_seen;
sub sum {
my $key = "@_";
return $sum_seen{$key} if exists $sum_seen{$key};
return $sum_seen{$key} = List::Util::sum(@_);
}
my %avail_seen;
sub avail {
my ($all, $max, @group) = @_;
my $sum = sum(@group);
return if $sum > $max;
my $pick = "@group";
my $key = "$pick:@$all";
return @{$avail_seen{$key}} if exists $avail_seen{$key};
my %used;
++$used{$_} for @group;
my @left = grep 0 > --$used{$_}, @$all;
my $diff = $max - $sum;
$avail_seen{$key} = [$pick, \@left];
return ($pick, \@left) if ! @left || $left[0] > $diff;
$avail_seen{$key} = [];
return;
}
sub progressive {
my ($max, @list) = @_;
if (@list == 1) {
return sub {
my $val = shift @list;
return $val ? $val : ();
};
}
my $end = $#list;
my @subset;
my ($pos, $mode) = (-1, 1);
my %seen;
my $fetch = sub {
if ( $seen{ "@list[ @subset ]" }++ ) {
if ( $mode == 1 ) {
push @subset, $pos + 1 .. $end;
++$mode;
}
return ();
}
my $sum = sum(@list[ @subset ]);
return $sum > $max ? () : @list[ @subset ];
};
my %dispatch = (
1 => sub {
push @subset, ++$pos;
++$mode if $subset[ -1 ] == $end;
return 1;
},
2 => sub {
splice(@subset, $#subset - 1, 1);
return $mode++;
},
3 => sub {
return () if $subset[ 0 ] == $end;
$pos = $subset[ -2 ] + 1;
splice(@subset, $#subset - 1, 2, $pos);
return $mode = 1;
},
);
return sub {
{
return () if ! $dispatch{ $mode }->();
my @group = $fetch->() or redo;
return @group;
}
};
}
'This statement is false';
The script set up with some sane defaults:
#!perl
use strict;
use warnings;
use Max::Bins;
my $max = $ARGV[0] || 30;
my @can = sort {$a <=> $b} map {int(rand $max) + 1} 1 .. 10;
my @work;
my $next = progressive($max, @can);
while (my @group = $next->()) {
my ($pick, $left) = avail(\@can, $max, @group);
next if ! $pick;
push @work, {left => $left, depth => 1, path => $pick};
}
my ($path, $water_mark) = ('', 1);
while (@work) {
my $choice = pop @work;
my @can = @{$choice->{left}};
my $next = progressive($max, @can);
while (my @group = $next->()) {
my ($pick, $left) = avail(\@can, $max, @group);
next if ! $pick;
my $depth = $choice->{depth} + 1;
my $way = $choice->{path} . ":$pick";
($path, $water_mark) = ($way, $depth) if $depth > $water_mark;
push @work, {left => $left, depth => $depth, path => $way} if
+@$left + $depth > $water_mark;
}
}
print $path;
