File Coverage

lib/Algorithm/Evolutionary/Hash_Wheel.pm

Criterion	Covered	Total	%
statement	31	31	100.0
branch			n/a
condition	1	2	50.0
subroutine	5	5	100.0
pod	2	2	100.0
total	39	40	97.5

use strict;
use warnings;

=head1 NAME

Algorithm::Evolutionary::Hash_Wheel - Random selector of things depending on probabilities

=head1 SYNOPSIS

    my $wheel = new Algorithm::Evolutionary::Hash_Wheel( \%probs );
    print $wheel->spin(); #Returns an element according to probabilities;

=head1 DESCRIPTION

Creates a "roulette wheel" for spinning and selecting stuff. It will
be used in several places; mainly in the
L. It's similar to
L, but with a hash instead of an
array. Probably should unify both..

=head1 METHODS

=cut

package Algorithm::Evolutionary::Hash_Wheel;
use Carp;

our ($VERSION) = ( '$Revision: 1.2 $ ' =~ / (\d+\.\d+)/ ) ;

=head2 new( $probabilities_hashref )

Creates a new roulette wheel. Takes a hashref, which uses as keys the
objects to be returned by the roulette wheel, and as values the ones
that are going to be used

=cut

sub new {
  my $class = shift;
  my $probs_hashref = shift || die "No probabilities hash";

  my %probs = %$probs_hashref;
  my $self = { _accProbs => [] };

  my $acc = 0;
  for ( sort keys %probs ) { $acc += $probs{$_};}
  for ( sort keys %probs ) { $probs{$_} /= $acc;} #Normalizes array

  #Now creates the accumulated array, putting the accumulated
  #probability in the first element arrayref element, and the object
  #in the second
  my $aux = 0;
  for ( sort keys %probs ) {
	push @{$self->{_accProbs}}, [$probs{$_} + $aux,$_ ];
	$aux += $probs{$_};
  }

  bless $self, $class;
  return $self;
}

=head2 spin()

Returns a single individual whose probability is related to its fitness
TODO: should return many, probably

=cut

sub spin {
  my $self = shift;
  my $i = 0;
  my $rand = rand();
  while ( $self->{_accProbs}[$i]->[0] < $rand ) { $i++ };
  return $self->{_accProbs}[$i]->[1];

}
=head1 Copyright

  This file is released under the GPL. See the LICENSE file included in this distribution,
  or go to http://www.fsf.org/licenses/gpl.txt

  CVS Info: $Date: 2010/03/16 18:39:40 $
  $Header: /cvsroot/opeal/Algorithm-Evolutionary/lib/Algorithm/Evolutionary/Hash_Wheel.pm,v 1.2 2010/03/16 18:39:40 jmerelo Exp $
  $Author: jmerelo $

=cut

"The truth is by here";

#Test code
#my @array = qw( 5 4 3 2 1 );
#my $wheel = new Wheel @array;

#my @histo;
#for ( 0..100 ){
#  my $s = $wheel->spin();
#  print "$s\n";
#  $histo[$s]++;
#}

#for ( 0..(@histo - 1)){
#  print $_, " => $histo[$_] \n";
#}

#my @array2 = qw( 1 3 7 4 2 1 );
#my $wheel2 = new Wheel @array2;

#my @histo2;
#for ( 0..100 ){
#  my $s = $wheel2->spin();
#  print "$s\n";
#  $histo2[$s]++;
#}

#for ( 0..(@histo2 - 1)){
#  print $_, " => $histo2[$_] \n";
#}