AI::Genetic::OpSelection - A class that implements various selection operators.

AI-Genetic documentation Contained in the AI-Genetic distribution.

Index

Code Index:

NAME

Top

AI::Genetic::OpSelection - A class that implements various selection operators.

SYNOPSIS

Top

See AI::Genetic.

DESCRIPTION

Top

This package implements a few selection mechanisms that can be used in user-defined strategies. The methods in this class are to be called as static class methods, rather than instance methods, which means you must call them as such:

  AI::Genetic::OpSelection::MethodName(arguments)

SELECTION OPERATORS AND THEIR METHODS

Top

The following selection operators are defined:

Roulette Wheel

Here, the probability of an individual being selected is proportional to its fitness score. The following methods are defined:

initWheel(population)

This method initializes the roulette wheel. It expects an anonymous list of individuals, as returned by the people() method as described in CLASS METHODS in AI::Genetic. This must be called only once.

roulette(?N?)

This method selects N individuals. N defaults to 2. Note that the same individual can be selected multiple times.

rouletteUnique(?N?)

This method selects N unique individuals. N defaults to 2. Any individual can be selected only once per call to this method.

Tournament

Here, N individuals are randomly selected, and the fittest one of them is returned. The following method is defined:

tournament(?N?)

N defaults to 2. Note that only one individual is returned per call to this method.

Random

Here, N individuals are randomly selected and returned. The following method is defined:

random(?N?)

N defaults to 1.

Fittest

Here, the fittest N individuals of the whole population are returned. The following method is defined:

topN(?N?)

N defaults to 1.

AUTHOR

Top

Written by Ala Qumsieh aqumsieh@cpan.org.

COPYRIGHTS

Top

(c) 2003,2004 Ala Qumsieh. All rights reserved. This module is distributed under the same terms as Perl itself.

AI-Genetic documentation Contained in the AI-Genetic distribution. 
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) {
      if ($wheel[$i][0] <= $rand && $rand < $wheel[$i][1]) {
	$selected{$i} = 1;
	last;
      }
    }
  }

  return map $wheelPop->[$_], keys %selected;
}

# sub tournament():
# arguments are anon list of population, and number
# of individuals in tournament (def = 2).
# return 1 individual.

sub tournament {
  my ($pop, $num) = @_;

  $num ||= 2;

  my %s;
  while ($num > keys %s) {
    my $i = int rand @$pop;
    $s{$i} = 1;
  }

  return (sort {$b->score <=> $a->score}
	  map {$_->score; $_}  # This avoids a bug in Perl. See Genetic.pm.
	  map $pop->[$_], keys %s)[0];
}

# sub random():
# pure random choice of individuals.
# arguments are anon list of population, and number
# of individuals to select (def = 1).
# returns selected individual(s).

sub random {
  my ($pop, $num) = @_;

  $num ||= 1;

  my %s;
  while ($num > keys %s) {
    my $i = int rand @$pop;
    $s{$i} = 1;
  }

  return map $pop->[$_], keys %s;
}

# sub topN():
# fittest N individuals.
# arguments are anon list of pop, and N (def = 1).
# return anon list of top N individuals.

sub topN {
  my ($pop, $N) = @_;

  $N ||= 1;

  # hmm .. are inputs already sorted?
  return [(sort {$b->score <=> $a->score}
	   map {$_->score; $_}  # This avoids a bug in Perl. See Genetic.pm.
	   @$pop)[0 .. $N-1]];
}

1;

__END__