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';
[download]

#!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;
[download]