view release on metacpan or  search on metacpan

Genetic/OpSelection.pm  view on Meta::CPAN

package AI::Genetic::OpSelection;

use strict;

my @wheel;
my $wheelPop;

# sub init():
# initializes the roulette wheel array.
# must be called whenever the population changes.
# only useful for roulette().

sub initWheel {
  my $pop = shift;

  my $tot = 0;
  $tot += $_->score for @$pop;

  # if all population has zero score, then none
  # deserves to be selected.
  $tot = 1 unless $tot;    # to avoid div by zero

  # normalize
  my @norms = map {$_->score / $tot} @$pop;

  @wheel = ();

  my $cur = 0;
  for my $i (@norms) {
    push @wheel => [$cur, $cur + $i];
    $cur += $i;
  }

  $wheelPop = $pop;
}

# sub roulette():
# Roulette Wheel selection.
# argument is number of individuals to select (def = 2).
# returns selected individuals.

sub roulette {
  my $num = shift || 2;

  my @selected;

  for my $j (1 .. $num) {
    my $rand = rand;
    for my $i (0 .. $#wheel) {
      if ($wheel[$i][0] <= $rand && $rand < $wheel[$i][1]) {
	push @selected => $wheelPop->[$i];
	last;
      }
    }
  }

  return @selected;
}

# same as roulette(), but returns unique individuals.
sub rouletteUnique {
  my $num = shift || 2;

  # make sure we select unique individuals.
  my %selected;

  while ($num > keys %selected) {
    my $rand = rand;

    for my $i (0 .. $#wheel) {