view release on metacpan or  search on metacpan

Bucketizer.pm  view on Meta::CPAN

##################################################
package Algorithm::Bucketizer;
##################################################
# Documentation attached as POD below
##################################################

use 5.006;
use strict;
use warnings;

our $VERSION = '0.13';

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

    my $self = {     # Overwritable parameters
                 bucketsize      => 100,
                 algorithm       => "simple",
                 add_buckets     => 1,

                 @options,
           
                     # Internal stuff

                   # index (0-..) of bucket we're currently 
                   # inserting items into
                 cur_bucket_idx  => 0,

                 buckets         => [],
               };

    bless $self, $class;
}

##################################################
sub add_item {
##################################################
    my($self, $item, $size) = @_;

      # in 'simple' mode, we continue with the bucket we
      # inserted the last item into
    my $first = $self->{cur_bucket_idx};

      # retry tries all buckets
    $first = 0 if $self->{algorithm} eq 'retry';

        # Check if it fits in any existing bucket.
    for(my $idx = $first; exists $self->{buckets}->[$idx]; $idx++) {

        my $bucket = $self->{buckets}->[$idx];

        if($bucket->probe_item($item, $size)) {
            $bucket->add_item($item, $size);
            $self->{ cur_bucket_idx } = $idx;
            return $bucket;
        }
    }

        # It didn't fit anywhere. Create a new bucket.
    return undef unless $self->{add_buckets};
    my $bucket = $self->add_bucket();

    if($bucket->probe_item($item, $size)) {
        $bucket->add_item($item, $size);
        $self->{ cur_bucket_idx } = $bucket->{ idx };
        return $bucket;
    }

    # It didn't even fit in a new bucket. Forget it.
    return undef;
}

##################################################
sub current_bucket_idx {
##################################################
    my($self, $idx ) = @_;

    if( defined $idx ) {
        $self->{ cur_bucket_idx } = $idx;
    }

    return $self->{ cur_bucket_idx };
}

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

    my $bucket = Algorithm::Bucketizer::Bucket->new(
        maxsize => $self->{bucketsize},
        idx     => $#{ $self->{ buckets } } + 1,

Bucketizer.pm  view on Meta::CPAN

    # 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,
               };

    bless $self, $class;
}

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

    return ($self->{idx} + 1);
}

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

    return ($self->{size});
}

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

    return ($self->{idx});
}

##################################################
sub add_item {
##################################################
    my($self, $item, $size) = @_;

        # Does item fit in container?
    if($self->probe_item($item, $size)) {
            # Add it
        push @{$self->{items}}, $item;
        push @{$self->{sizes}}, $size;
        $self->{size} += $size;
        return 1;
    }

    return undef;
}

##################################################
sub probe_item {
##################################################
    my($self, $item, $size) = @_;

        # Does item fit in container?
    if($self->{maxitems}) {
        if(scalar $self->{items} >= $self->{maxitems}) {
            return 0;
        }
    }

    if($self->{size} + $size <= $self->{maxsize}) {
        return 1;
    } else {
        return 0;
    }