AI-Genetic

 view release on metacpan or  search on metacpan

Genetic.pm  view on Meta::CPAN

		 tournamentSinglePoint => \&AI::Genetic::Defaults::tournamentSinglePoint,
		 tournamentTwoPoint    => \&AI::Genetic::Defaults::tournamentTwoPoint,
		 tournamentUniform     => \&AI::Genetic::Defaults::tournamentUniform,

		 randomSinglePoint => \&AI::Genetic::Defaults::randomSinglePoint,
		 randomTwoPoint    => \&AI::Genetic::Defaults::randomTwoPoint,
		 randomUniform     => \&AI::Genetic::Defaults::randomUniform,
		);

# this hash maps the genome types to the
# classes they're defined in.

my %_genome2class = (
		     bitvector   => 'AI::Genetic::IndBitVector',
		     rangevector => 'AI::Genetic::IndRangeVector',
		     listvector  => 'AI::Genetic::IndListVector',
		    );

##################

Genetic/Defaults.pm  view on Meta::CPAN

    no strict 'refs';
    $ssub = \&{"AI::Genetic::OpSelection::$selOp"};
    $xsub = \&{"AI::Genetic::OpCrossover::$Xop"};
    $msub = \&{"AI::Genetic::OpMutation::$mutOp"};
  }

  for my $i (1 .. $size/2) {
    my @parents = $ssub->(@$selArgs);
    @parents < 2 and push @parents => $ssub->(@$selArgs);

    my @cgenes  = $xsub->($crossProb, map scalar $_->genes, @parents);

    # check if two didn't mate.
    unless (ref $cgenes[0]) {
      @cgenes = map scalar $_->genes, @parents;
    }

    # mutate them.
    $_ = $msub->(@mutArgs, $_) for @cgenes;

    # push them into pop.
    push @newPop => map $pop->[0]->new($_), @cgenes;
  }

  # assign the fitness function. This is UGLY.
  my $fit = $pop->[0]->fitness;
  $_->fitness($fit) for @newPop;

  # now chop in half and reassign the population.
  $ga->people(AI::Genetic::OpSelection::topN([@$pop, @newPop], $size));
}

Genetic/OpSelection.pm  view on Meta::CPAN

  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;

Genetic/OpSelection.pm  view on Meta::CPAN

    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__

=head1 NAME

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