view release on metacpan or  search on metacpan

Bucketizer.pm  view on Meta::CPAN

    return $bucket;
}

##################################################
sub buckets {
##################################################
    my($self) = @_;
   
    return @{$self->{buckets}};
}

##################################################
sub prefill_bucket {
##################################################
    my($self, $bucket_idx, $item, $size) = @_;
   
    my $bucket = $self->{buckets}->[$bucket_idx];

        # Create the bucket if it doesn't exist yet
    if(!exists $self->{buckets}->[$bucket_idx]) {
        $bucket = Algorithm::Bucketizer::Bucket->new(
            maxsize => $self->{bucketsize},
            idx     => $bucket_idx,
        );
        $self->{buckets}->[$bucket_idx] = $bucket;
        $self->{cur_bucket_idx}  = $bucket_idx;
    }

    $bucket->add_item($item, $size);
    return $bucket;
}

##################################################
sub optimize {
##################################################
    my($self, %options) = @_;

    $options{algorithm} = "random" unless defined $options{algorithm};
    $options{maxtime}   = 3 if exists $options{maxtime} and 
                                       $options{maxtime} < 3;
    my($next);

    my @items = $self->items();

        # Create next() closure for appropriate variation algorithm
    if($options{algorithm} eq "brute_force") {
        require Algorithm::Permute;
        my $p = Algorithm::Permute->new([@items]);
        $next = sub { return $p->next };
    } elsif($options{algorithm} eq "random") {
        # fisher-yates shuffle
        $next = sub { $self->shuffle(@items) };
        die "Need maxrounds|maxtime for 'random' optimizer" 
            if !exists $options{maxrounds} and !exists $options{maxtime};
    }

    my $round = 0;

    my $minbuckets;
    my @minitems;
    my $start_time = time();

        # Run through different setups and determine the one
        # requiring a minimum of buckets.
    while (my @res = $next->()) {

       my $b = Algorithm::Bucketizer->new(bucketsize => $self->{bucketsize},
                                          algorithm  => 'retry');
       for (@res) {
           my($name, $weight) = @$_;
           $b->add_item($name, $weight);
       }

       my $nof_buckets = scalar $b->buckets;

       if(! defined $minbuckets or $nof_buckets < $minbuckets) {
           $minbuckets = $nof_buckets;
           @minitems = @res;
       }

       ++$round;
       last if exists $options{maxrounds} and $round >= $options{maxrounds};
       last if exists $options{maxtime} and 
           time() > $start_time + $options{maxtime};
    }

    # We should have a ideal distribution now, nuke all buckets and refill
    $self->{buckets}         = [];
    $self->{cur_bucket_idx}  = 0;
    $self->{algorithm}       = "retry"; # We're optimizing

    for (@minitems) {
        my($name, $weight) = @$_;
        $self->add_item($name, $weight);
    }
}

##################################################
sub items {
##################################################
    my($self) = @_;

    my @items = ();

    for my $bucket (@{$self->{buckets}}) {
        for(my $idx = 0; exists $bucket->{items}->[$idx]; $idx++) {
            push @items, [$bucket->{items}->[$idx], $bucket->{sizes}->[$idx]];
        }
    }

    return @items;
}

###########################################
sub shuffle {
###########################################
    my($self, @array) = @_;

    for(my $i=@array; --$i; ) {
        my $j = int rand ($i+1);
        next if $i == $j;
        @array[$i,$j] = @array[$j,$i];
    }

    return @array;
}

##################################################
package Algorithm::Bucketizer::Bucket;
##################################################

##################################################
sub new {
##################################################
    my($class, @options) = @_;

    my $self = { size      => 0,
                 items     => [],
                 sizes     => [],
                 maxsize   => undef,
                 maxitems  => undef,
                 idx       => 0,
                 @options,
               };

Bucketizer.pm  view on Meta::CPAN

  my $serial = $bucket->serial();
  
=head1 DESCRIPTION

So, you own a number of mp3-Songs on your hard disc and want to copy them to 
a number of CDs, maxing out the space available on each of them?
You want to distribute your picture collection into several folders, 
so each of them doesn't exceed a certain size? C<Algorithm::Bucketizer>
comes to the rescue.

C<Algorithm::Bucketizer> distributes items of a defined size into
a number of dynamically created buckets, each of them capable of
holding items of a defined total size.

By calling the C<$bucketizer-E<gt>add_item()> method with the item (can be
a scalar or an object reference) and its size as parameters, you're adding
items to the system. The bucketizer will determine if the item
fits into one of the existing buckets and put it in there if possible.
If none of the existing buckets has enough space left to hold the
new item (or if no buckets exist yet for that matter), 
the bucketizer will create a new bucket and put the item 
in there.

After adding all items to the system, the bucketizer lets you iterate
over all buckets 
with the C<$bucketizer-E<gt>items()> method
and determine what's in each of them.

=head2 Algorithms

Currently, C<Algorithm::Bucketizer> comes with two algorithms, C<simple> and
C<retry>. 

In C<simple> mode, the algorithm will just try to fit in your items
in the order in which they're arriving. If an item fits into the current bucket,
it's being dropped in, if not, the algorithm moves on to the next bucket. It
never goes back to previous buckets, although a new item might as well 
fit in there. This mode might be useful if preserving the original order
of items is required. To query/manipulate the bucket the Bucketizer
will try to fit in the next item, use C<current_bucket_index()> explained
below.

In C<retry> mode, the algorithm will try each existing bucket first, 
before opening
a new one. If you have many items of various sizes, C<retry> allows you to fit
them into less buckets than in C<simple> mode.

The C<new()> method chooses the algorithm:

    my $dumb = Algorithm::Bucketizer->new( algorithm => "simple" );

    my $smart = Algorithm::Bucketizer->new( algorithm => "retry" );

In addition to these inserting algorithms, check L<"Optimize">
to optimize the distribution, minimizing the number of required buckets.

=head2 Prefilling Buckets

Sometimes you will have preexisting buckets, which you need to 
tell the algorithm 
about before it starts adding new items. The C<prefill_bucket()> method
does exactly that, simply putting an item into a specified bucket:

    $b->prefill_bucket($bucket_idx, $item, $itemsize);

C<$bucket_idx> is the index of the bucket, starting from 0. Non-existing buckets
are automatically created for you. Make sure you have a consecutive number
of buckets at the end of the prefill.

=head2 Optimize

Once you've inserted all items, you might choose to optimize the distribution
over the buckets, in order to I<minimize> the number of required buckets
to hold all the elements.

Optimally distributing a number discrete-sized items into a 
number of discrete-sized buckets, however, is a non-trivial task. 
It's the "bin-packing problem", related to the 
"knapsack problem", which are both I<NP-complete>.

C<Algorithm::Bucketize> therefore provides different optimization
techniques to (stupidly) approximate an ideal solution, which can't 
be obtained otherwise (yet).

Currently, it implements C<"random"> and C<"brute_force">.

C<"random"> tries to randomly vary the distribution until a time
or round limit is reached.

        # Try randomly to improve distribution, 
        # timing out after 100 rounds
    $b->optimize(algorithm => "random", maxrounds => 100);

        # Try randomly to improve distribution, 
        # timing out after 60 secs
    $b->optimize(algorithm => "random", maxtime => 60);

        # Try to improve distribution by brute_force trying
        # all possible combinations (watch out: can take forever)
    $b->optimize(algorithm => "brute_force",
                 maxtime => ..., 
                 maxrounds => ...,
                );

I'm currently evaluating more sophisticated methods suggested by
more mathematically inclined people :).

=head1 FUNCTIONS

=over 4

=item *

    my $b = Algorithm::Bucketizer->new(
        bucketsize => $size, 
        algorithm  => $algorithm 
       );

Creates a new C<Algorithm::Bucketizer> object and returns a reference to it.

The C<bucketsize> name-value pair is
somewhat mandatory, because you want to set the size of your buckets, otherwise
they will default to 100, which isn't what you want in most cases. 

C<algorithm> can be left out, it defaults to C<"simple">. 
If you want retry behaviour, specify C<"retry"> (see L<"Algorithms">).