view release on metacpan or  search on metacpan

lib/Algorithm/BinPack.pm  view on Meta::CPAN

package Algorithm::BinPack;

our $VERSION = 0.5;

=head1 NAME

Algorithm::BinPack - efficiently pack items into bins

=head1 SYNOPSIS

C<Algorithm::BinPack> efficiently packs items into bins. The bins are 
given a maximum size, and items are packed in with as little empty 
space as possible. An example use would be backing up files to CD, 
while minimizing the number of discs required. 

    my $bp = Algorithm::BinPack->new(binsize => 4);

    $bp->add_item(label => "one",   size => 1);
    $bp->add_item(label => "two",   size => 2);
    $bp->add_item(label => "three", size => 3);
    $bp->add_item(label => "four",  size => 4);

    for ($bp->pack_bins) {
        print "Bin size: ", $_->{size},  "\n";
        print "  Item: ",   $_->{label}, "\n" for @{ $_->{items} };
    }

=cut

use strict;
use warnings;
use Carp;

=head1 METHODS

=over 8

=item new

Creates a new C<Algorithm::BinPack> object. The maximum bin size is 
specified as a named argument 'binsize', and is required. A fudge 
factor may be specified as a named argument 'fudge'. If a fudge factor 
is specified, item sizes will be rounded up to a number divisible by 
the fudge factor. This can help keep items with similar sizes in order 
by their labels.

    my $bp = Algorithm::BinPack->new(binsize => 4);
    my $bp = Algorithm::BinPack->new(binsize => 100, fudge => 10);

=cut

sub new {
    my $name = shift;
    my $self = { @_ };

    checkargs($self, qw(binsize)) or return;

    $self->{bins} = [];

    bless $self, $name;
}

=item add_item

Adds an item to be packed into a bin. Required named arguments are 
'label' and 'size', but any others can be specified, and will be saved. 
An optional 'bin' argument can be used to manually put an item into the 
specified bin.

    $bp->add_item(label => 'one',  size => 1);
    $bp->add_item(label => 'two',  size => 2, desc => 'The second numeral');
    $bp->add_item(label => 'zero', size => 3, bin => 0);
    $bp->add_item(qw(label three size 3));
    $bp->add_item(qw(label four size 4 random key));

=cut

sub add_item {
    my $self = shift;
    my $item = { @_ };

    checkargs($item, qw(label size)) or return;

    if (exists $item->{bin}) {
        my ($bins, $max_binsize) = @{$self}{qw(bins binsize)};
        my ($bin, $size, $label) = @{$item}{qw(bin size label)};

        if ($size > $max_binsize) {
            carp("'$label' too big to fit in a bin\n");
            return 0;
        }

        if ($bin !~ /^\d+$/) {
            carp("Bin number must be numeric: $bin\n");
            return 0;
        }

        my $binsize = $bins->[$bin]{size} || 0;
        if ($size + $binsize > $max_binsize) {
            carp("'$label' too big to fit in a bin #$bin size: $binsize\n");
            return 0;
        }

        push @{ $bins->[$bin]{items} }, $item;
        $bins->[$bin]{size} += $size;

        return 1;
    } else {
        if ($self->{fudge}) {
            require POSIX;

            my $fudge = $self->{fudge};
            my $size  = $item->{size};

            $item->{fudgesize} = POSIX::ceil($size/$fudge)*$fudge;
        }

        push @{ $self->{items} }, $item;
    }
}