AI-Genetic
view release on metacpan - search on metacpan
view release on metacpan or search on metacpan
Revision history for Perl extension AI::Genetic.
0.01 Tue Nov 18 18:04:12 2003
- original version; created by h2xs 1.21 with options
-AX -n AI::Genetic
0.02 Fri Apr 16 14:15:17 2004
- Packaged v0.02 for CPAN.
- This is a complete re-write from scratch.
0.03 Thu Mar 3 16:13:35 2005
- Fixed bug where range vector genes were not always
integers.
- Implemented a work-around to a sort bug in Perl. The
bug is discussed here:
http://rt.perl.org/rt3/Ticket/Display.html?id=7063
0.04 Mon Jul 18 16:51:47 PDT 2005
- Fixed bugs reported by crenz@web42.com regarding
rangevectors. Turns out that the last element
in the range was never reached. Fixed.
0.05 Fri May 11 10:46:09 PDT 2007
- Fixed bug reported by yraber@mailup.net regarding
listvectors. If a single option is given for a
listvector genome, then mutation would run in an
infinite loop. Fixed.
- updated docs a bit to better show how to specify
the fitness and termination functions.
package AI::Genetic;
use strict;
use Carp;
use vars qw/$VERSION/;
$VERSION = 0.05;
use AI::Genetic::Defaults;
# new AI::Genetic. More modular.
# Not too many checks are done still.
##### Shared private vars
# this hash predefines some strategies
my %_strategy = (
rouletteSinglePoint => \&AI::Genetic::Defaults::rouletteSinglePoint,
rouletteTwoPoint => \&AI::Genetic::Defaults::rouletteTwoPoint,
rouletteUniform => \&AI::Genetic::Defaults::rouletteUniform,
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',
);
##################
# sub new():
# This is the constructor. It creates a new AI::Genetic
# object. Options are:
# -population: set the population size
# -crossover: set the crossover probability
# -mutation: set the mutation probability
# -fitness: set the fitness function
# -type: set the genome type. See docs.
# -terminate: set termination sub.
sub new {
my ($class, %args) = @_;
my $self = bless {
ADDSEL => {}, # user-defined selections
ADDCRS => {}, # user-defined crossovers
ADDMUT => {}, # user-defined mutations
ADDSTR => {}, # user-defined strategies
} => $class;
$self->{FITFUNC} = $args{-fitness} || sub { 1 };
$self->{CROSSRATE} = $args{-crossover} || 0.95;
$self->{MUTPROB} = $args{-mutation} || 0.05;
$self->{POPSIZE} = $args{-population} || 100;
$self->{TYPE} = $args{-type} || 'bitvector';
$self->{TERM} = $args{-terminate} || sub { 0 };
$self->{PEOPLE} = []; # list of individuals
$self->{GENERATION} = 0; # current gen.
$self->{INIT} = 0; # whether pop is initialized or not.
$self->{SORTED} = 0; # whether the population is sorted by score or not.
$self->{INDIVIDUAL} = ''; # name of individual class to use().
return $self;
}
# sub createStrategy():
# This method creates a new strategy.
# It takes two arguments: name of strategy, and
# anon sub that implements it.
sub createStrategy {
my ($self, $name, $sub) = @_;
if (ref($sub) eq 'CODE') {
$self->{ADDSTR}{$name} = $sub;
} else {
# we don't know what this operation is.
carp <<EOC;
ERROR: Must specify anonymous subroutine for strategy.
Strategy '$name' will be deleted.
EOC
;
delete $self->{ADDSTR}{$name};
return undef;
}
return $name;
}
# sub evolve():
# This method evolves the population using a specific strategy
# for a specific number of generations.
sub evolve {
my ($self, $strategy, $gens) = @_;
unless ($self->{INIT}) {
carp "can't evolve() before init()";
return undef;
}
my $strSub;
if (exists $self->{ADDSTR}{$strategy}) {
$strSub = $self->{ADDSTR}{$strategy};
} elsif (exists $_strategy{$strategy}) {
$strSub = $_strategy{$strategy};
} else {
carp "ERROR: Do not know what strategy '$strategy' is,";
return undef;
}
$gens ||= 1;
for my $i (1 .. $gens) {
$self->sortPopulation;
$strSub->($self);
$self->{GENERATION}++;
$self->{SORTED} = 0;
last if $self->{TERM}->($self);
# my @f = $self->getFittest(10);
# for my $f (@f) {
# print STDERR " Fitness = ", $f->score, "..\n";
# print STDERR " Genes are: @{$f->genes}.\n";
# }
}
}
# sub sortIndividuals():
# This method takes as input an anon list of individuals, and returns
# another anon list of the same individuals but sorted in decreasing
# score.
sub sortIndividuals {
my ($self, $list) = @_;
# make sure all score's are calculated.
# This is to avoid a bug in Perl where a sort is called from whithin another
# sort, and they are in different packages, then you get a use of uninit value
# warning. See http://rt.perl.org/rt3/Ticket/Display.html?id=7063
$_->score for @$list;
return [sort {$b->score <=> $a->score} @$list];
}
# sub sortPopulation():
# This method sorts the population of individuals.
sub sortPopulation {
my $self = shift;
return if $self->{SORTED};
$self->{PEOPLE} = $self->sortIndividuals($self->{PEOPLE});
$self->{SORTED} = 1;
}
# sub getFittest():
# This method returns the fittest individuals.
sub getFittest {
my ($self, $N) = @_;
$N ||= 1;
$N = 1 if $N < 1;
$N = @{$self->{PEOPLE}} if $N > @{$self->{PEOPLE}};
$self->sortPopulation;
my @r = @{$self->{PEOPLE}}[0 .. $N-1];
return $r[0] if $N == 1 && not wantarray;
return @r;
}
# sub init():
# This method initializes the population to completely
# random individuals. It deletes all current individuals!!!
# It also examines the type of individuals we want, and
# require()s the proper class. Throws an error if it can't.
# Must pass to it an anon list that will be passed to the
# newRandom method of the individual.
# In case of bitvector, $newArgs is length of bitvector.
# In case of rangevector, $newArgs is anon list of anon lists.
# each sub-anon list has two elements, min number and max number.
# In case of listvector, $newArgs is anon list of anon lists.
# Each sub-anon list contains possible values of gene.
sub init {
my ($self, $newArgs) = @_;
$self->{INIT} = 0;
my $ind;
if (exists $_genome2class{$self->{TYPE}}) {
$ind = $_genome2class{$self->{TYPE}};
} else {
$ind = $self->{TYPE};
}
eval "use $ind"; # does this work if package is in same file?
if ($@) {
carp "ERROR: Init failed. Can't require '$ind': $@,";
return undef;
}
$self->{INDIVIDUAL} = $ind;
$self->{PEOPLE} = [];
$self->{SORTED} = 0;
$self->{GENERATION} = 0;
$self->{INITARGS} = $newArgs;
push @{$self->{PEOPLE}} =>
$ind->newRandom($newArgs) for 1 .. $self->{POPSIZE};
$_->fitness($self->{FITFUNC}) for @{$self->{PEOPLE}};
$self->{INIT} = 1;
}
# sub people():
# returns the current list of individuals in the population.
# note: this returns the actual array ref, so any changes
# made to it (ex, shift/pop/etc) will be reflected in the
# population.
sub people {
my $self = shift;
if (@_) {
$self->{PEOPLE} = shift;
$self->{SORTED} = 0;
}
$self->{PEOPLE};
}
# useful little methods to set/query parameters.
sub size { $_[0]{POPSIZE} = $_[1] if defined $_[1]; $_[0]{POPSIZE} }
sub crossProb { $_[0]{CROSSRATE} = $_[1] if defined $_[1]; $_[0]{CROSSRATE} }
sub mutProb { $_[0]{MUTPROB} = $_[1] if defined $_[1]; $_[0]{MUTPROB} }
sub indType { $_[0]{INDIVIDUAL} }
sub generation { $_[0]{GENERATION} }
# sub inject():
# This method is used to add individuals to the current population.
# The point of it is that sometimes the population gets stagnant,
# so it could be useful add "fresh blood".
# Takes a variable number of arguments. The first argument is the
# total number, N, of new individuals to add. The remaining arguments
# are genomes to inject. There must be at most N genomes to inject.
# If the number, n, of genomes to inject is less than N, N - n random
# genomes are added. Perhaps an example will help?
# returns 1 on success and undef on error.
sub inject {
my ($self, $count, @genomes) = @_;
unless ($self->{INIT}) {
carp "can't inject() before init()";
return undef;
}
my $ind = $self->{INDIVIDUAL};
my @newInds;
for my $i (1 .. $count) {
my $genes = shift @genomes;
if ($genes) {
push @newInds => $ind->newSpecific($genes, $self->{INITARGS});
} else {
push @newInds => $ind->newRandom ($self->{INITARGS});
}
}
$_->fitness($self->{FITFUNC}) for @newInds;
push @{$self->{PEOPLE}} => @newInds;
return 1;
}
__END__
=head1 NAME
AI::Genetic - A pure Perl genetic algorithm implementation.
=head1 SYNOPSIS
use AI::Genetic;
my $ga = new AI::Genetic(
-fitness => \&fitnessFunc,
-type => 'bitvector',
-population => 500,
-crossover => 0.9,
-mutation => 0.01,
-terminate => \&terminateFunc,
);
$ga->init(10);
$ga->evolve('rouletteTwoPoint', 100);
print "Best score = ", $ga->getFittest->score, ".\n";
sub fitnessFunc {
my $genes = shift;
my $fitness;
# assign a number to $fitness based on the @$genes
# ...
return $fitness;
}
sub terminateFunc {
my $ga = shift;
# terminate if reached some threshold.
return 1 if $ga->getFittest->score > $THRESHOLD;
return 0;
}
=head1 DESCRIPTION
This module implements a Genetic Algorithm (GA) in pure Perl.
Other Perl modules that achieve the same thing (perhaps better,
perhaps worse) do exist. Please check CPAN. I mainly wrote this
module to satisfy my own needs, and to learn something about GAs
along the way.
B<PLEASE NOTE:> As of v0.02, AI::Genetic has been re-written from
scratch to be more modular and expandable. To achieve this, I had
to modify the API, so it is not backward-compatible with v0.01.
As a result, I do not plan on supporting v0.01.
I will not go into the details of GAs here, but here are the
bare basics. Plenty of information can be found on the web.
In a GA, a population of individuals compete for survival. Each
individual is designated by a set of genes that define its
behaviour. Individuals that perform better (as defined by the
fitness function) have a higher chance of mating with other
individuals. When two individuals mate, they swap some of
their genes, resulting in an individual that has properties
from both of its "parents". Every now and then, a mutation
occurs where some gene randomly changes value, resulting in
a different individual. If all is well defined, after a few
generations, the population should converge on a "good-enough"
solution to the problem being tackled.
A GA implementation runs for a discrete number of time steps
called I<generations>. What happens during each generation can
vary greatly depending on the strategy being used (See
L</"STRATEGIES"> for more info).
Typically, a variation of the following happens at
each generation:
=over 4
=item B<1. Selection>
Here the performance of all the individuals is evaluated
based on the fitness function, and each is given a specific
fitness value. The higher the value, the bigger the chance
of an individual passing its genes on in future generations
through mating (crossover).
=item B<2. Crossover>
Here, individuals selected are randomly paired up for
crossover (aka I<sexual reproduction>). This is further
controlled by the crossover rate specified and may result in
a new offspring individual that contains genes common to
both parents. New individuals are injected into the current
population.
=item B<3. Mutation>
In this step, each individual is given the chance to mutate
based on the mutation probability specified. If an individual
is to mutate, each of its genes is given the chance to randomly
switch its value to some other state.
=back
=head1 CLASS METHODS
Here are the public methods.
=over 4
=item I<$ga>-E<gt>B<new>(I<options>)
This is the constructor. It accepts options in the form of
hash-value pairs. These are:
=over 8
=item B<-population>
This defines the size of the population, i.e. how many individuals
to simultaneously exist at each generation. Defaults to 100.
=item B<-crossover>
This defines the crossover rate. Defaults to 0.95.
=item B<-mutation>
This defines the mutation rate. Defaults to 0.05.
=item I<-fitness>
This defines a fitness function. It expects a reference to a subroutine.
More details are given in L</"FITNESS FUNCTION">.
=item I<-type>
This defines the type of the genome. Currently, AI::Genetic
supports only three types:
=over
=item I<bitvector>
Individuals of this type have genes that are bits. Each gene
can be in one of two possible states, on or off.
=item I<listvector>
Each gene of a listvector individual can assume one string value from
a specified list of possible string values.
=item I<rangevector>
Each gene of a rangevector individual can assume one integer value
from a range of possible integer values. Note that only integers are
supported. The user can always transform any desired fractional values
by multiplying and dividing by an appropriate power of 10.
=back
Defaults to I<bitvector>.
=item I<-terminate>
This option allows the definition of a termination subroutine.
It expects a subroutine reference. This sub will be called at
the end of each generation with one argument: the AI::Genetic
object. Evolution terminates if the sub returns a true value.
=back
=item I<$ga>-E<gt>B<createStrategy>(I<strategy_name>, I<sub_ref>)
This method allows the creation of a custom-made strategy to be used
during evolution. It expects a unique strategy name, and a subroutine
reference as arguments. The subroutine will be called with one argument:
the AI::Genetic object. It is expected to alter the population at each
generation. See L</"STRATEGIES"> for more information.
=item I<$ga>-E<gt>B<init>(I<initArgs>)
This method initializes the population with random individuals. It B<MUST>
be called before any call to I<evolve()> or I<inject()>. As a side effect,
any already existing individuals in the population are deleted. It expects
one argument, which depends on the type of individuals:
=over
=item o
For bitvectors, the argument is simply the length of the bitvector.
$ga->init(10);
this initializes a population where each individual has 10 genes.
=item o
For listvectors, the argument is an anonymous list of lists. The
number of sub-lists is equal to the number of genes of each individual.
Each sub-list defines the possible string values that the corresponding gene
can assume.
$ga->init([
[qw/red blue green/],
[qw/big medium small/],
[qw/very_fat fat fit thin very_thin/],
]);
this initializes a population where each individual has 3 genes, and each gene
can assume one of the given values.
=item o
For rangevectors, the argument is an anonymous list of lists. The
number of sub-lists is equal to the number of genes of each individual.
Each sub-list defines the minimum and maximum integer values that the
corresponding gene can assume.
$ga->init([
[1, 5],
[0, 20],
[4, 9],
]);
this initializes a population where each individual has 3 genes, and each gene
can assume an integer within the corresponding range.
=back
=item I<$ga>-E<gt>B<inject>(I<N>, ?I<args>?)
This method can be used to add more individuals to the population. New individuals
can be randomly generated, or be explicitly specified. The first argument specifies
the number, I<N>, of new individuals to add. This can be followed by at most I<N>
arguments, each of which is an anonymous list that specifies the genome of a
single individual to add. If the number of genomes given, I<n>, is less than I<N>, then
I<N> - I<n> random individuals are added for a total of I<N> new individuals. Random
individuals are generated using the same arguments passed to the I<init()> method.
For example:
$ga->inject(5,
[qw/red big thin/],
[qw/blue small fat/],
);
this adds 5 new individuals, 2 with the specified genetic coding, and 3 randomly
generated.
=item I<$ga>-E<gt>B<evolve>(I<strategy>, ?I<num_generations>?)
This method causes the GA to evolve the population using the specified strategy.
A strategy name has to be specified as the first argument. The second argument
is optional and specifies the number of generations to evolve. It defaults to
1. See L</"STRATEGIES"> for more information on the default strategies.
Each generation consists of the following steps:
=over
=item o
The population is sorted according to the individuals' fitnesses.
=item o
The subroutine corresponding to the named strategy is called with one argument,
the AI::Genetic object. This subroutine is expected to alter the object itself.
=item o
If a termination subroutine is given, it is executed and the return value is
checked. Evolution terminates if this sub returns a true value.
=back
=item I<$ga>-E<gt>B<getFittest>(?I<N>?)
This returns the I<N> fittest individuals. If not specified,
I<N> defaults to 1. As a side effect, it sorts the population by
fitness score. The actual AI::Genetic::Individual objects are returned.
You can use the C<genes()> and C<score()> methods to get the genes and the
scores of the individuals. Please check L<AI::Genetic::Individual> for details.
=item I<$ga>-E<gt>B<sortPopulation>
This method sorts the population according to fitness function. The results
are cached for speed.
=item I<$ga>-E<gt>B<sortIndividuals>(?[I<ListOfIndividuals>]?)
Given an anonymous list of individuals, this method sorts them according
to fitness, returning an anonymous list of the sorted individuals.
=item I<$ga>-E<gt>B<people>()
Returns an anonymous list of individuals of the current population.
B<IMPORTANT>: the actual array reference used by the AI::Genetic object
is returned, so any changes to it will be reflected in I<$ga>.
=item I<$ga>-E<gt>B<size>(?I<newSize>?)
This method is used to query and set the population size.
=item I<$ga>-E<gt>B<crossProb>(?I<newProb>?)
This method is used to query and set the crossover rate.
=item I<$ga>-E<gt>B<mutProb>(?I<newProb>?)
This method is used to query and set the mutation rate.
=item I<$ga>-E<gt>B<indType>()
This method returns the type of individual: I<bitvector>, I<listvector>,
or I<rangevector>.
=item I<$ga>-E<gt>B<generation>()
This method returns the current generation.
=back
=head1 FITNESS FUNCTION
Very quickly you will realize that properly defining the fitness function
is the most important aspect of a GA. Most of the time that a genetic
algorithm takes to run is spent in running the fitness function for each
separate individual to get its fitness. AI::Genetic tries to minimize this
time by caching the fitness result for each individual. But, B<you should
spend a lot of time optimizing your fitness function to achieve decent run
times.>
The fitness function should expect only one argument, an anonymous list of
genes, corresponding to the individual being analyzed. It is expected
to return a number which defines the fitness score of the said individual.
The higher the score, the more fit the individual, the more the chance it
has to be chosen for crossover.
=head1 STRATEGIES
AI::Genetic comes with 9 predefined strategies. These are:
=over
=item rouletteSinglePoint
This strategy implements roulette-wheel selection and single-point crossover.
=item rouletteTwoPoint
This strategy implements roulette-wheel selection and two-point crossover.
=item rouletteUniform
This strategy implements roulette-wheel selection and uniform crossover.
=item tournamentSinglePoint
This strategy implements tournament selection and single-point crossover.
=item tournamentTwoPoint
This strategy implements tournament selection and two-point crossover.
=item tournamentUniform
This strategy implements tournament selection and uniform crossover.
=item randomSinglePoint
This strategy implements random selection and single-point crossover.
=item randomTwoPoint
This strategy implements random selection and two-point crossover.
=item randomUniform
This strategy implements random selection and uniform crossover.
=back
More detail on these strategies and how to call them in your own
custom strategies can be found in L<AI::Genetic::OpSelection>,
L<AI::Genetic::OpCrossover> and L<AI::Genetic::OpMutation>.
You can use the functions defined in the above modules in your
own custom-made strategy. Consult their manpages for more info.
A custom-made strategy can be defined using the I<strategy()>
method and is called at the beginning of each generation. The only
argument to it is the AI::Genetic object itself. Note that the
population at this point is sorted accoring to each individual's
fitness score. It is expected that the strategy sub will modify
the population stored in the AI::Genetic object. Here's the
pseudo-code of events:
for (1 .. num_generations) {
sort population;
call strategy_sub;
if (termination_sub exists) {
call termination_sub;
last if returned true value;
}
}
=head1 A NOTE ON SPEED/EFFICIENCY
Genetic algorithms are inherently slow.
Perl can be pretty fast, but will never reach the speed of optimized
C code (at least my Perl coding will not). I wrote AI::Genetic mainly
for my own learning experience, but still tried to optimize it as
much as I can while trying to keep it as flexible as possible.
To do that, I resorted to some well-known tricks like passing a
reference of a long list instead of the list itself (for example,
when calling the fitness function, a reference of the gene list
is passed), and caching fitness scores (if you try to evaluate
the fitness of the same individual more than once, then the fitness
function will not be called, and the cached result is returned).
To help speed up your run times, you should pay special attention
to the design of your fitness function since this will be called once
for each unique individual in each generation. If you can shave off a
few clock cycles here and there, then it will be greatly magnified in
the total run time.
=head1 BUGS
I have tested this module quite a bit, and even used it to solve a
work-related problem successfully. But, if you think you found a bug
then please let me know, and I promise to look at it.
Also, if you have any requests, comments or suggestions, then feel
free to email me.
=head1 INSTALLATION
Either the usual:
perl Makefile.PL
make
make install
or just stick it somewhere in @INC where perl can find it. It is in pure Perl.
=head1 AUTHOR & CREDITS
Written by Ala Qumsieh I<aqumsieh@cpan.org>.
Special thanks go to John D. Porter and Oliver Smith for stimulating
discussions and great suggestions. Daniel Martin and Ivan Tubert-Brohman
uncovered various bugs and for this I'm grateful.
=head1 COPYRIGHTS
(c) 2003-2005 Ala Qumsieh. All rights reserved.
This module is distributed under the same terms as Perl itself.
=cut
Genetic/Defaults.pm view on Meta::CPAN
package AI::Genetic::Defaults;
use strict;
use AI::Genetic::OpSelection;
use AI::Genetic::OpCrossover;
use AI::Genetic::OpMutation;
1;
# this implements the default strategies.
sub rouletteSinglePoint {
# initialize the roulette wheel
AI::Genetic::OpSelection::initWheel($_[0]->people);
push @_ => 'vectorSinglePoint', 'rouletteUnique';
goto &genericStrategy;
}
sub rouletteTwoPoint {
# initialize the roulette wheel
AI::Genetic::OpSelection::initWheel($_[0]->people);
push @_ => 'vectorTwoPoint', 'rouletteUnique';
goto &genericStrategy;
}
sub rouletteUniform {
# initialize the roulette wheel
AI::Genetic::OpSelection::initWheel($_[0]->people);
push @_ => 'vectorUniform', 'rouletteUnique';
goto &genericStrategy;
}
sub tournamentSinglePoint {
push @_ => 'vectorSinglePoint', 'tournament', [$_[0]->people];
goto &genericStrategy;
}
sub tournamentTwoPoint {
push @_ => 'vectorTwoPoint', 'tournament', [$_[0]->people];
goto &genericStrategy;
}
sub tournamentUniform {
push @_ => 'vectorUniform', 'tournament', [$_[0]->people];
goto &genericStrategy;
}
sub randomSinglePoint {
push @_ => 'vectorSinglePoint', 'random', [$_[0]->people];
goto &genericStrategy;
}
sub randomTwoPoint {
push @_ => 'vectorTwoPoint', 'random', [$_[0]->people];
goto &genericStrategy;
}
sub randomUniform {
push @_ => 'vectorUniform', 'random', [$_[0]->people];
goto &genericStrategy;
}
# generic sub that implements everything.
sub genericStrategy {
my ($ga, $Xop, $selOp, $selArgs) = @_;
#perhaps args should be:
# ($ga, [xop, xargs], [selop, selargs]) ?
my $pop = $ga->people;
# now double up the individuals, and get top half.
my $size = $ga->size;
my $ind = $ga->indType;
my @newPop;
# optimize
my $crossProb = $ga->crossProb;
# figure out mutation routine to use, and its arguments.
my @mutArgs = ($ga->mutProb);
my $mutOp = 'bitVector';
if ($ind =~ /IndRangeVector/) {
$mutOp = 'rangeVector';
push @mutArgs => $pop->[0]->ranges;
} elsif ($ind =~ /IndListVector/) {
$mutOp = 'listVector';
push @mutArgs => $pop->[0]->lists;
}
my ($ssub, $xsub, $msub);
{
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/IndBitVector.pm view on Meta::CPAN
package AI::Genetic::IndBitVector;
use strict;
use base qw/AI::Genetic::Individual/;
1;
sub newRandom {
my ($class, $length) = @_;
my $self = bless {
GENES => [],
SCORE => 0,
FITFUNC => sub {},
CALCED => 0,
} => $class;
push @{$self->{GENES}} => rand > 0.5 ? 1 : 0
for 1 .. $length;
return $self;
}
sub newSpecific {
my ($class, $genes) = @_;
my $self = bless {
GENES => $genes,
CALCED => 0,
SCORE => 0,
FITFUNC => sub {},
} => $class;
return $self;
}
sub genes {
my $self = shift;
return wantarray ? @{$self->{GENES}} : [@{$self->{GENES}}];
}
Genetic/IndListVector.pm view on Meta::CPAN
package AI::Genetic::IndListVector;
use strict;
use base qw/AI::Genetic::Individual/;
1;
sub newRandom {
my ($class, $lists) = @_;
my $self = bless {
GENES => [],
SCORE => 0,
FITFUNC => sub {},
CALCED => 0,
LISTS => $lists,
} => $class;
push @{$self->{GENES}} => $_->[rand @$_] for @$lists;
return $self;
}
sub newSpecific {
my ($class, $genes, $lists) = @_;
my $self = bless {
GENES => $genes,
CALCED => 0,
SCORE => 0,
FITFUNC => sub {},
LISTS => $lists,
} => $class;
return $self;
}
sub genes {
my $self = shift;
return wantarray ? @{$self->{GENES}} : [@{$self->{GENES}}];
}
sub lists { $_[0]{LISTS} }
Genetic/IndRangeVector.pm view on Meta::CPAN
package AI::Genetic::IndRangeVector;
use strict;
use base qw/AI::Genetic::Individual/;
1;
sub newRandom {
my ($class, $ranges) = @_;
my $self = bless {
GENES => [],
SCORE => 0,
FITFUNC => sub {},
CALCED => 0,
RANGES => $ranges,
} => $class;
for my $r (@$ranges) {
my $rand = $r->[0] + int rand($r->[1] - $r->[0] + 1);
push @{$self->{GENES}} => $rand;
}
return $self;
}
sub newSpecific {
my ($class, $genes, $ranges) = @_;
my $self = bless {
GENES => $genes,
CALCED => 0,
SCORE => 0,
FITFUNC => sub {},
RANGES => $ranges,
} => $class;
return $self;
}
sub genes {
my $self = shift;
return wantarray ? @{$self->{GENES}} : [@{$self->{GENES}}];
}
sub ranges { $_[0]{RANGES} }
Genetic/Individual.pm view on Meta::CPAN
package AI::Genetic::Individual;
use strict;
use vars qw/$VERSION/;
$VERSION = 0.02;
# this package is to serve as a base package to
# all other individuals. It doesn't do anything
# interesting.
1;
sub new { # hmm .. do I need this?
my ($class, $genes) = @_;
my $self;
if (ref $class) { # clone mode
$self = bless {} => ref $class;
$self->{$_} = $class->{$_} for keys %$class;
$self->{GENES} = $genes;
$self->{CALCED} = 0;
} else { # new mode. Genome is given
goto &newSpecific;
}
return $self;
}
sub new_old { # hmm .. do I need this?
my ($class, $genes) = @_;
my $self;
if (ref $class) { # clone mode
$self = bless {} => ref $class;
$self->{$_} = $class->{$_} for keys %$class;
$self->{GENES} = $genes;
$self->{CALCED} = 0;
} else { # new mode. Just call newRandom.
goto &newRandom;
}
return $self;
}
# should create default methods.
# those are the only three needed.
sub newRandom {}
sub newSpecific {}
sub genes {}
# the following methods shouldn't be overridden.
sub fitness {
my ($self, $sub) = @_;
$self->{FITFUNC} = $sub if $sub;
return $self->{FITFUNC};
}
sub score {
my $self = shift;
return $self->{SCORE} if $self->{CALCED};
$self->{SCORE} = $self->{FITFUNC}->(scalar $self->genes);
$self->{CALCED} = 1;
return $self->{SCORE};
}
sub resetScore { $_[0]{CALCED} = 0 }
# hmmm .. how do I reset {CALCED} in case of mutation?
__END__
=head1 NAME
AI::Genetic::Individual - Base class for AI::Genetic Individuals.
=head1 SYNOPSIS
See L<AI::Genetic>.
=head1 DESCRIPTION
This package implements the base class for all AI::Genetic individuals.
It provides basic methods required by AI::Genetic for correct evolution.
Furthermore, it can be very easily used as a base class for additional
types of individuals. AI::Genetic comes with three individual types that
inherit from this class. These are I<IndBitVector>, I<IndListVector>,
and I<IndRangeVector>.
See L</CREATING YOUR OWN INDIVIDUAL CLASS> for more details.
=head1 CLASS METHODS
The following methods are accessible publicly. They are not meant to
be over-ridden:
=over
=item I<$individual> -E<gt>B<new(options)>
=item I<AI::Genetic::IndBitVector> -E<gt>B<new(options)>
=item I<AI::Genetic::IndListVector> -E<gt>B<new(options)>
=item I<AI::Genetic::IndRangeVector>-E<gt>B<new(options)>
This is the default constructor. It can be called as an instance method or
as a class method. In both cases it returns a new individual of
the proper type.
If called as an instance method, it expects one argument
which defines the genes of the individual. All other attributes, like
fitness function, class, etc, will be copied from the calling
instance.
If called as a class method, then it calls I<newSpecific()>. See below
for details.
=item I<$individual>-E<gt>B<fitness(?anon_sub?)>
This method is used to set/query the anonymous subroutine used to
calculate the individual's fitness. If an argument is given, it expects
a subroutine reference which will be set as the fitness subroutine. In
either case, it'll return the fitness sub ref.
=item I<$individual>-E<gt>B<score()>
This method returns the fitness score of the individual. If the score has
never been calculated before, then the fitness function is executed and
the score saved. Subsequent calls to score() will return the cached value.
=item I<$individual>-E<gt>B<resetScore()>
This method resets the score of the individual such that a subsequent call
to I<score()> will result in the execution of the fitness sub.
=back
The following methods are meant to be over-ridden by any class that
inherits from AI::Genetic::Individual:
=over 4
=item I<$individual>-E<gt>B<newRandom(options)>
This method returns an individual with random genes. It is called with the
arguments supplied to I<AI::Genetic::init()> as explained in
L<AI::Genetic/I<$ga>-E<gt>B<init>(I<initArgs>)>.
=item I<$individual>-E<gt>B<newSpecific(options)>
This method returns an individual with the given genetic makeup. The
options depend on the type of individual:
=over
=item o bitvector
One argument is expected which is an anonymous list of genes:
AI::Genetic::IndBitVector->new([0, 1, 1, 0, 1, 0]);
=item o listvector
Two arguments are expected. The first is an anonymous list of
genes, the second is an anonymous list of lists of possible gene values,
similar to the argument of I<newRandom>.
AI::Genetic::IndListVector->new(
[qw/red medium fat/], # genes
[ # possible values
[qw/red blue green/],
[qw/big medium small/],
[qw/very_fat fat fit thin very_thin/],
]);
=item o rangevector
Two arguments are expected. The first is an anonymous list of
genes, the second is an anonymous list of lists of possible gene values,
similar to the argument of I<newRandom>.
AI::Genetic::IndListVector->new(
[3, 14, 4], # genes
[ # possible values
[1, 5],
[0, 20],
[4, 9],
]);
=back
=item I<$individual>-E<gt>B<genes()>
In list context, returns a list of genes. In scalar context returns an
anonymous list of the genes.
=back
Other useful non-generic methods:
=over
=item I<$listVectorInd>-E<gt>B<lists()>
This method returns an anonymous list of lists which describes the possible
value of each gene for the given AI::Genetic::IndListVector individual. This
is the same argument passed to I<newRandom()>.
=item I<$rangeVectorInd>-E<gt>B<ranges()>
This method returns an anonymous list of lists which describes the possible
range of each gene for the given AI::Genetic::IndRangeVector individual. This
is the same argument passed to I<newRandom()>.
=back
=head1 CREATING YOUR OWN INDIVIDUAL CLASS
Creating your own individual class is easy. All you have to do is inherit from
AI::Genetic::Individual and override the I<newRandom()>, I<newSpecific>, and
I<genes()> methods to conform with the documentation above. Specifically, the
arguments to i<newRandom> and I<newSpecific> have to match what I<AI::Genetic::init()>
expects as arguments. You can also define any additional methods that you might
require in your own custom-made strategies.
Note that in order for your own individual class to be useful, you have to define
your own custom strategy that knows how to evolve such individuals. Conceptually,
this should be very simple.
=head1 AUTHOR
Written by Ala Qumsieh I<aqumsieh@cpan.org>.
=head1 COPYRIGHTS
(c) 2003,2004 Ala Qumsieh. All rights reserved.
This module is distributed under the same terms as Perl itself.
=cut
=cut
Genetic/OpCrossover.pm view on Meta::CPAN
package AI::Genetic::OpCrossover;
use strict;
1;
# sub vectorSinglePoint():
# Single point crossover.
# arguments are crossover prob, two
# anon lists of genes (parents).
# If crossover occurs, returns two anon lists
# of children genes. If no crossover, returns 0.
# both parents have to be of same length.
sub vectorSinglePoint {
my ($prob, $mom, $dad) = @_;
return 0 if rand > $prob;
# get single index from 1 to $#{$dad}
my $ind = 1 + int rand $#{$dad};
my @c1 = (@$mom[0 .. $ind - 1],
@$dad[$ind .. $#{$dad}]);
my @c2 = (@$dad[0 .. $ind - 1],
@$mom[$ind .. $#{$dad}]);
return (\@c1, \@c2);
}
# sub vectorTwoPoint():
# Two point crossover.
# arguments are crossover prob, two
# anon lists of genes (parents).
# If crossover occurs, returns two anon lists
# of children genes. If no crossover, returns 0.
# both parents have to be of same length.
sub vectorTwoPoint {
my ($prob, $mom, $dad) = @_;
return 0 if rand > $prob;
# get first index from 1 to $#{$dad}-1
my $ind1 = 1 + int rand($#{$dad} - 1);
# get second index from $ind1 to $#{$dad}
my $ind2 = $ind1 + 1 + int rand($#{$dad} - $ind1);
my @c1 = (@$mom[0 .. $ind1 - 1],
@$dad[$ind1 .. $ind2 - 1],
@$mom[$ind2 .. $#{$dad}]);
my @c2 = (@$dad[0 .. $ind1 - 1],
@$mom[$ind1 .. $ind2 - 1],
@$dad[$ind2 .. $#{$dad}]);
return (\@c1, \@c2);
}
# sub vectorUniform():
# Uniform crossover.
# arguments are crossover prob, two
# anon lists of genes (parents).
# If crossover occurs, returns two anon lists
# of children genes. If no crossover, returns 0.
# both parents have to be of same length.
sub vectorUniform {
my ($prob, $mom, $dad) = @_;
return 0 if rand > $prob;
my (@c1, @c2);
for my $i (0 .. $#{$dad}) {
if (rand > 0.5) {
push @c1 => $mom->[$i];
push @c2 => $dad->[$i];
} else {
push @c2 => $mom->[$i];
push @c1 => $dad->[$i];
}
}
return (\@c1, \@c2);
}
__END__
=head1 NAME
AI::Genetic::OpCrossover - A class that implements various crossover operators.
=head1 SYNOPSIS
See L<AI::Genetic>.
=head1 DESCRIPTION
This package implements a few crossover 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::OpCrossover::MethodName(arguments)
=head1 CROSSOVER OPERATORS AND THEIR METHODS
The following crossover operators are defined:
=over
=item Single Point
In single point crossover, a point is selected along the choromosomes of both parents.
The chromosomes are then split at that point, and the head of one parent chromosome is
joined with the tail of the other and vice versa, creating two child chromosomes.
The following method is defined:
=over
=item B<vectorSinglePoint>(I<Xprob, parent1, parent2>)
The first argument is the crossover rate. The second and third arguments are anonymous
lists that define the B<genes>
of the parents (not AI::Genetic::Individual objects, but the return value of the I<genes()>
method in scalar context).
If mating occurs, two anonymous lists of genes are returned corresponding to the two
new children. If no mating occurs, 0 is returned.
=back
=item Two Point
In two point crossover, two points are selected along the choromosomes of both parents.
The chromosomes are then cut at those points, and the middle parts are swapped,
creating two child chromosomes. The following method is defined:
=over
=item B<vectorTwoPoint>(I<Xprob, parent1, parent2>)
The first argument is the crossover rate. The second and third arguments are anonymous
lists that define the B<genes>
of the parents (not AI::Genetic::Individual objects, but the return value of the I<genes()>
method in scalar context).
If mating occurs, two anonymous lists of genes are returned corresponding to the two
new children. If no mating occurs, 0 is returned.
=back
=item Uniform
In uniform crossover, two child chromosomes are created by looking at each gene in both
parents, and randomly selecting which one to go with each child.
The following method is defined:
=over
=item B<vectorUniform>(I<Xprob, parent1, parent2>)
The first argument is the crossover rate. The second and third arguments are anonymous
lists that define the B<genes>
of the parents (not AI::Genetic::Individual objects, but the return value of the I<genes()>
method in scalar context).
If mating occurs, two anonymous lists of genes are returned corresponding to the two
new children. If no mating occurs, 0 is returned.
=back
=back
=head1 AUTHOR
Written by Ala Qumsieh I<aqumsieh@cpan.org>.
=head1 COPYRIGHTS
(c) 2003,2004 Ala Qumsieh. All rights reserved.
This module is distributed under the same terms as Perl itself.
=cut
Genetic/OpMutation.pm view on Meta::CPAN
package AI::Genetic::OpMutation;
use strict;
1;
# This package implements various mutation
# algorithms. To be used as static functions.
# sub bitVector():
# each gene is a bit: 0 or 1. arguments are mutation
# prob. and anon list of genes.
# returns anon list of mutated genes.
sub bitVector {
my ($prob, $genes) = @_;
for my $g (@$genes) {
next if rand > $prob;
$g = $g ? 0 : 1;
}
return $genes;
}
# sub rangeVector():
# each gene is a floating number, and can be anything
# within a range of two numbers.
# arguments are mutation prob., anon list of genes,
# and anon list of ranges. Each element in $ranges is
# an anon list of two numbers, min and max value of
# the corresponding gene.
sub rangeVector {
my ($prob, $ranges, $genes) = @_;
my $i = -1;
for my $g (@$genes) {
$i++;
next if rand > $prob;
# now randomly choose another value from the range.
my $abs = $ranges->[$i][1] - $ranges->[$i][0] + 1;
$g = $ranges->[$i][0] + int rand($abs);
}
return $genes;
}
# sub listVector():
# each gene is a string, and can be anything
# from a list of possible values supplied by user.
# arguments are mutation prob., anon list of genes,
# and anon list of value lists. Each element in $lists
# is an anon list of the possible values of
# the corresponding gene.
sub listVector {
my ($prob, $lists, $genes) = @_;
my $i = -1;
for my $g (@$genes) {
$i++;
next if rand > $prob;
# now randomly choose another value from the lists.
my $new;
if (@{$lists->[$i]} == 1) {
$new = $lists->[$i][0];
} else {
do {
$new = $lists->[$i][rand @{$lists->[$i]}];
} while $new eq $g;
}
$g = $new;
}
return $genes;
}
__END__
=head1 NAME
AI::Genetic::OpMutation - A class that implements various mutation operators.
=head1 SYNOPSIS
See L<AI::Genetic>.
=head1 DESCRIPTION
This package implements a few mutation 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::OpCrossover::MethodName(arguments)
=head1 CLASS METHODS
There is really one kind of mutation operator implemented in this class, but it
implemented for the three default individuals types. Each gene of an individual
is looked at separately to decide whether it will be mutated or not. Mutation is
decided based upon the mutation rate (or probability). If a mutation is to happen,
then the value of the gene is switched to some other possible value.
For the case of I<bitvectors>, an ON gene switches to an OFF gene.
For the case of I<listvectors>, a gene's value is replaced by another one from
the possible list of values.
For the case of I<rangevectors>, a gene's value is replaced by another one from
the possible range of integers.
Thus, there are only three methods:
=over
=item B<bitVector>(I<mut_prob, genes>)
The method takes as input the mutation rate, and an anonymous list of genes of
a bitvector individual. The return value is an anonymous list of mutated genes.
Note that
it is possible that no mutation will occur, and thus the returned genes are
identical to the given ones.
=item B<listVector>(I<mut_prob, genes, possibleValues>)
The method takes as input the mutation rate, an anonymous list of genes of
a listvector individual, and a list of lists which describe the possible
values for each gene. The return value is an anonymous list of mutated genes.
Note that
it is possible that no mutation will occur, and thus the returned genes are
identical to the given ones.
=item B<rangeVector>(I<mut_prob, genes, rangeValues>)
The method takes as input the mutation rate, an anonymous list of genes of
a rangevector individual, and a list of lists which describe the range of
possible values for each gene. The return value is an anonymous list of
mutated genes. Note that
it is possible that no mutation will occur, and thus the returned genes are
identical to the given ones.
=back
=head1 AUTHOR
Written by Ala Qumsieh I<aqumsieh@cpan.org>.
=head1 COPYRIGHTS
(c) 2003,2004 Ala Qumsieh. All rights reserved.
This module is distributed under the same terms as Perl itself.
=cut
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) {
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.
=head1 SYNOPSIS
See L<AI::Genetic>.
=head1 DESCRIPTION
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)
=head1 SELECTION OPERATORS AND THEIR METHODS
The following selection operators are defined:
=over
=item Roulette Wheel
Here, the probability of an individual being selected is proportional to its fitness
score. The following methods are defined:
=over
=item B<initWheel>(I<population>)
This method initializes the roulette wheel. It expects an anonymous list of individuals,
as returned by the I<people()> method as described in L<AI::Genetic/CLASS METHODS>.
This B<must> be called only once.
=item B<roulette>(?I<N>?)
This method selects I<N> individuals. I<N> defaults to 2. Note that the same individual
can be selected multiple times.
=item B<rouletteUnique>(?I<N>?)
This method selects I<N> unique individuals. I<N> defaults to 2. Any individual
can be selected only once per call to this method.
=back
=item Tournament
Here, I<N> individuals are randomly selected, and the fittest one of
them is returned. The following method is defined:
=over
=item B<tournament>(?I<N>?)
I<N> defaults to 2. Note that only one individual is returned per call to this
method.
=back
=item Random
Here, I<N> individuals are randomly selected and returned.
The following method is defined:
=over
=item B<random>(?I<N>?)
I<N> defaults to 1.
=back
=item Fittest
Here, the fittest I<N> individuals of the whole population are returned.
The following method is defined:
=over
=item B<topN>(?I<N>?)
I<N> defaults to 1.
=back
=back
=head1 AUTHOR
Written by Ala Qumsieh I<aqumsieh@cpan.org>.
=head1 COPYRIGHTS
(c) 2003,2004 Ala Qumsieh. All rights reserved.
This module is distributed under the same terms as Perl itself.
=cut
Changes
Genetic.pm
Makefile.PL
MANIFEST
README
test.pl
Makefile.PL view on Meta::CPAN
use ExtUtils::MakeMaker;
# See lib/ExtUtils/MakeMaker.pm for details of how to influence
# the contents of the Makefile that is written.
WriteMakefile(
'NAME' => 'AI::Genetic',
'VERSION_FROM' => 'Genetic.pm', # finds $VERSION
'PREREQ_PM' => {}, # e.g., Module::Name => 1.1
($] >= 5.005 ? ## Add these new keywords supported since 5.005
(ABSTRACT_FROM => 'Genetic.pm', # retrieve abstract from module
AUTHOR => 'Ala Qumsieh <aqumsieh@cpan.org>') : ()),
);
NAME
AI::Genetic - A pure Perl genetic algorithm implementation.
SYNOPSIS
use AI::Genetic;
my $ga = new AI::Genetic(
-fitness => \&fitnessFunc,
-type => 'bitvector',
-population => 500,
-crossover => 0.9,
-mutation => 0.01,
-terminate => \&terminateFunc,
);
$ga->init(10);
$ga->evolve('rouletteTwoPoint', 100);
print "Best score = ", $ga->getFittest->score, ".\n";
sub fitnessFunc {
my $genes = shift;
my $fitness;
# assign a number to $fitness based on the @$genes
# ...
return $fitness;
}
sub terminateFunc {
my $ga = shift;
# terminate if reached some threshold.
return 1 if $ga->getFittest->score > $THRESHOLD;
return 0;
}
DESCRIPTION
This module implements a Genetic Algorithm (GA) in pure Perl. Other Perl
modules that achieve the same thing (perhaps better, perhaps worse) do
exist. Please check CPAN. I mainly wrote this module to satisfy my own
needs, and to learn something about GAs along the way.
PLEASE NOTE: As of v0.02, AI::Genetic has been re-written from scratch
to be more modular and expandable. To achieve this, I had to modify the
API, so it is not backward-compatible with v0.01. As a result, I do not
plan on supporting v0.01.
I will not go into the details of GAs here, but here are the bare
basics. Plenty of information can be found on the web.
In a GA, a population of individuals compete for survival. Each
individual is designated by a set of genes that define its behaviour.
Individuals that perform better (as defined by the fitness function)
have a higher chance of mating with other individuals. When two
individuals mate, they swap some of their genes, resulting in an
individual that has properties from both of its "parents". Every now and
then, a mutation occurs where some gene randomly changes value,
resulting in a different individual. If all is well defined, after a few
generations, the population should converge on a "good-enough" solution
to the problem being tackled.
A GA implementation runs for a discrete number of time steps called
*generations*. What happens during each generation can vary greatly
depending on the strategy being used (See the section on "STRATEGIES"
for more info). Typically, a variation of the following happens at each
generation:
1. Selection
Here the performance of all the individuals is evaluated based on
the fitness function, and each is given a specific fitness value.
The higher the value, the bigger the chance of an individual passing
its genes on in future generations through mating (crossover).
2. Crossover
Here, individuals selected are randomly paired up for crossover (aka
*sexual reproduction*). This is further controlled by the crossover
rate specified and may result in a new offspring individual that
contains genes common to both parents. New individuals are injected
into the current population.
3. Mutation
In this step, each individual is given the chance to mutate based on
the mutation probability specified. If an individual is to mutate,
each of its genes is given the chance to randomly switch its value
to some other state.
CLASS METHODS
Here are the public methods.
*$ga*->new(*options*)
This is the constructor. It accepts options in the form of
hash-value pairs. These are:
-population
This defines the size of the population, i.e. how many
individuals to simultaneously exist at each generation.
Defaults to 100.
-crossover
This defines the crossover rate. Defaults to 0.95.
-mutation
This defines the mutation rate. Defaults to 0.05.
*-fitness*
This defines a fitness function. It expects a reference to a
subroutine. More details are given in the section on
"FITNESS FUNCTION".
*-type* This defines the type of the genome. Currently, AI::Genetic
supports only three types:
*bitvector*
Individuals of this type have genes that are bits. Each
gene can be in one of two possible states, on or off.
*listvector*
Each gene of a listvector individual can assume one
string value from a specified list of possible string
values.
*rangevector*
Each gene of a rangevector individual can assume one
integer value from a range of possible integer values.
Note that only integers are supported. The user can
always transform any desired fractional values by
multiplying and dividing by an appropriate power of 10.
Defaults to *bitvector*.
*-terminate*
This option allows the definition of a termination
subroutine. It expects a subroutine reference. This sub will
be called at the end of each generation with one argument:
the AI::Genetic object. Evolution terminates if the sub
returns a true value.
*$ga*->createStrategy(*strategy_name*, *sub_ref*)
This method allows the creation of a custom-made strategy to be used
during evolution. It expects a unique strategy name, and a
subroutine reference as arguments. The subroutine will be called
with one argument: the AI::Genetic object. It is expected to alter
the population at each generation. See the section on "STRATEGIES"
for more information.
*$ga*->init(*initArgs*)
This method initializes the population with random individuals. It
MUST be called before any call to *evolve()* or *inject()*. As a
side effect, any already existing individuals in the population are
deleted. It expects one argument, which depends on the type of
individuals:
o For bitvectors, the argument is simply the length of the
bitvector.
$ga->init(10);
this initializes a population where each individual has 10
genes.
o For listvectors, the argument is an anonymous list of lists. The
number of sub-lists is equal to the number of genes of each
individual. Each sub-list defines the possible string values
that the corresponding gene can assume.
$ga->init([
[qw/red blue green/],
[qw/big medium small/],
[qw/very_fat fat fit thin very_thin/],
]);
this initializes a population where each individual has 3 genes,
and each gene can assume one of the given values.
o For rangevectors, the argument is an anonymous list of lists.
The number of sub-lists is equal to the number of genes of each
individual. Each sub-list defines the minimum and maximum
integer values that the corresponding gene can assume.
$ga->init([
[1, 5],
[0, 20],
[4, 9],
]);
this initializes a population where each individual has 3 genes,
and each gene can assume an integer within the corresponding
range.
*$ga*->inject(*N*, ?*args*?)
This method can be used to add more individuals to the population.
New individuals can be randomly generated, or be explicitly
specified. The first argument specifies the number, *N*, of new
individuals to add. This can be followed by at most *N* arguments,
each of which is an anonymous list that specifies the genome of a
single individual to add. If the number of genomes given, *n*, is
less than *N*, then *N* - *n* random individuals are added for a
total of *N* new individuals. Random individuals are generated using
the same arguments passed to the *init()* method. For example:
$ga->inject(5,
[qw/red big thin/],
[qw/blue small fat/],
);
this adds 5 new individuals, 2 with the specified genetic coding,
and 3 randomly generated.
*$ga*->evolve(*strategy*, ?*num_generations*?)
This method causes the GA to evolve the population using the
specified strategy. A strategy name has to be specified as the first
argument. The second argument is optional and specifies the number
of generations to evolve. It defaults to 1. See the section on
"STRATEGIES" for more information on the default strategies.
Each generation consists of the following steps:
o The population is sorted according to the individuals'
fitnesses.
o The subroutine corresponding to the named strategy is called
with one argument, the AI::Genetic object. This subroutine is
expected to alter the object itself.
o If a termination subroutine is given, it is executed and the
return value is checked. Evolution terminates if this sub
returns a true value.
*$ga*->getFittest(?*N*?)
This returns the *N* fittest individuals. If not specified, *N*
defaults to 1. As a side effect, it sorts the population by fitness
score. The actual AI::Genetic::Individual objects are returned. You
can use the "genes()" and "score()" methods to get the genes and the
scores of the individuals. Please check the AI::Genetic::Individual
manpage for details.
*$ga*->sortPopulation
This method sorts the population according to fitness function. The
results are cached for speed.
*$ga*->sortIndividuals(?[*ListOfIndividuals*]?)
Given an anonymous list of individuals, this method sorts them
according to fitness, returning an anonymous list of the sorted
individuals.
*$ga*->people()
Returns an anonymous list of individuals of the current population.
IMPORTANT: the actual array reference used by the AI::Genetic object
is returned, so any changes to it will be reflected in *$ga*.
*$ga*->size(?*newSize*?)
This method is used to query and set the population size.
*$ga*->crossProb(?*newProb*?)
This method is used to query and set the crossover rate.
*$ga*->mutProb(?*newProb*?)
This method is used to query and set the mutation rate.
*$ga*->indType()
This method returns the type of individual: *bitvector*,
*listvector*, or *rangevector*.
*$ga*->generation()
This method returns the current generation.
FITNESS FUNCTION
Very quickly you will realize that properly defining the fitness
function is the most important aspect of a GA. Most of the time that a
genetic algorithm takes to run is spent in running the fitness function
for each separate individual to get its fitness. AI::Genetic tries to
minimize this time by caching the fitness result for each individual.
But, you should spend a lot of time optimizing your fitness function to
achieve decent run times.
The fitness function should expect only one argument, an anonymous list
of genes, corresponding to the individual being analyzed. It is expected
to return a number which defines the fitness score of the said
individual. The higher the score, the more fit the individual, the more
the chance it has to be chosen for crossover.
STRATEGIES
AI::Genetic comes with 9 predefined strategies. These are:
rouletteSinglePoint
This strategy implements roulette-wheel selection and single-point
crossover.
rouletteTwoPoint
This strategy implements roulette-wheel selection and two-point
crossover.
rouletteUniform
This strategy implements roulette-wheel selection and uniform
crossover.
tournamentSinglePoint
This strategy implements tournament selection and single-point
crossover.
tournamentTwoPoint
This strategy implements tournament selection and two-point
crossover.
tournamentUniform
This strategy implements tournament selection and uniform crossover.
randomSinglePoint
This strategy implements random selection and single-point
crossover.
randomTwoPoint
This strategy implements random selection and two-point crossover.
randomUniform
This strategy implements random selection and uniform crossover.
More detail on these strategies and how to call them in your own custom
strategies can be found in the AI::Genetic::OpSelection manpage, the
AI::Genetic::OpCrossover manpage and the AI::Genetic::OpMutation
manpage.
You can use the functions defined in the above modules in your own
custom-made strategy. Consult their manpages for more info. A
custom-made strategy can be defined using the *strategy()* method and is
called at the beginning of each generation. The only argument to it is
the AI::Genetic object itself. Note that the population at this point is
sorted accoring to each individual's fitness score. It is expected that
the strategy sub will modify the population stored in the AI::Genetic
object. Here's the pseudo-code of events:
for (1 .. num_generations) {
sort population;
call strategy_sub;
if (termination_sub exists) {
call termination_sub;
last if returned true value;
}
}
A NOTE ON SPEED/EFFICIENCY
Genetic algorithms are inherently slow. Perl can be pretty fast, but
will never reach the speed of optimized C code (at least my Perl coding
will not). I wrote AI::Genetic mainly for my own learning experience,
but still tried to optimize it as much as I can while trying to keep it
as flexible as possible.
To do that, I resorted to some well-known tricks like passing a
reference of a long list instead of the list itself (for example, when
calling the fitness function, a reference of the gene list is passed),
and caching fitness scores (if you try to evaluate the fitness of the
same individual more than once, then the fitness function will not be
called, and the cached result is returned).
To help speed up your run times, you should pay special attention to the
design of your fitness function since this will be called once for each
unique individual in each generation. If you can shave off a few clock
cycles here and there, then it will be greatly magnified in the total
run time.
BUGS
I have tested this module quite a bit, and even used it to solve a
work-related problem successfully. But, if you think you found a bug
then please let me know, and I promise to look at it.
Also, if you have any requests, comments or suggestions, then feel free
to email me.
INSTALLATION
Either the usual:
perl Makefile.PL
make
make install
or just stick it somewhere in @INC where perl can find it. It is in pure
Perl.
AUTHOR & CREDITS
Written by Ala Qumsieh *aqumsieh@cpan.org*.
Special thanks go to John D. Porter and Oliver Smith for stimulating
discussions and great suggestions. Daniel Martin and Ivan Tubert-Brohman
uncovered various bugs and for this I'm grateful.
COPYRIGHTS
(c) 2003-2005 Ala Qumsieh. All rights reserved. This module is
distributed under the same terms as Perl itself.
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'
#########################
# change 'tests => 1' to 'tests => last_test_to_print';
use Test;
BEGIN { plan tests => 1 };
use AI::Genetic;
ok(1); # If we made it this far, we're ok.
#########################
# Insert your test code below, the Test module is use()ed here so read
# its man page ( perldoc Test ) for help writing this test script.
view release on metacpan - search on metacpan
( run in 2.206 seconds using v1.00-cache-2.02-grep-82fe00e-cpan-cec75d87357c )