Algorithm-Evolutionary
view release on metacpan or search on metacpan
* lib/Algorithm/Evolutionary/Op/Tournament_Selection.pm (apply):
Changed call to subroutine to using hash value for speed.
2012-12-08 Juan J. Merelo <jmerelo@sheldon>
* scripts/tide_float.pl: Changed script to make it end when
solution is found.
* lib/Algorithm/Evolutionary/Op/VectorCrossover.pm (apply): Fixed
bug: the incoming parent was modified along with the offspring.
2012-07-10 Juan J. Merelo Guervós <jjmerelo@gmail.com>
* MANIFEST: Eliminating pod.t also in production code.
2012-07-09 Juan J. Merelo Guervós <jjmerelo@gmail.com>
* MANIFEST: Eliminated pod-coverage.t, which is not needed for
production and causes errors in some systems.
2011-11-23 Juan Julian Merelo Guervos <jjmerelo@gmail.com>
* lib/Algorithm/Evolutionary/Individual/Vector.pm (clone): Change
suggested by Cristoph Meissner, comma between fitness and
chromosome.
2011-02-20 Juan J. Merelo Guervós <jjmerelo@gmail.com>
* lib/Algorithm/Evolutionary/Op/Breeder_Diverser.pm (apply): Made
even more diverse by not inserting the new individual if it is the
same as the parent; refactored also to best practices.
* lib/Algorithm/Evolutionary/Op/Uniform_Crossover_Diff.pm (apply):
Changed to leave at least one difference without change
2011-02-19 Juan J. Merelo Guervós <jjmerelo@gmail.com>
* lib/Algorithm/Evolutionary/Op/Breeder_Diverser.pm (apply):
Changed to make diversification higher: offspring is chosen in
turn, instead of chosing it randomly, which avoids repeating.
lib/Algorithm/Evolutionary/Individual/Tree.pm view on Meta::CPAN
} elsif ( $options->{primitives}{$node->name()}[0] == 0 ){ #Add comma
if ($node->right_sister() ) {
${$strRef} .= ", ";
}
}
}
=head2 closeParens
Internal subrutine: closes node parenthesis
=cut
sub closeParens {
my $node = shift;
my $options = shift;
my $strRef = $options->{str};
if ( $options->{primitives}{$node->name()}[0] > 0 ) { #That's the arity
${$strRef} .= " ) ";
if ($node->right_sister() ) {
lib/Algorithm/Evolutionary/Op/ArithCrossover.pm view on Meta::CPAN
use strict;
use warnings;
use lib qw(../../..);
=head1 NAME
Algorithm::Evolutionary::Op::ArithCrossover - Arithmetic crossover operator; performs the average of the n parents crossed
=head1 SYNOPSIS
my $xmlStr6=<<EOC; #Create it from XML
<op name='ArithCrossover' type='binary' rate='1' />
EOC
my $ref6 = XMLin($xmlStr6);
my $op6 = Algorithm::Evolutionary::Op::Base->fromXML( $ref6 );
print $op6->asXML(), "\n";
lib/Algorithm/Evolutionary/Op/Breeder_Diverser.pm view on Meta::CPAN
}
=head2 apply( $population[, $how_many || $population_size] )
Applies the algorithm to the population, which should have
been evaluated first; checks that it receives a
ref-to-array as input, croaks if it does not. Returns a sorted,
culled, evaluated population for next generation.
It is valid only for string-denominated chromosomes. Checks that the
offspring is different from parents before inserting it.
=cut
sub apply ($) {
my $self = shift;
my $pop = shift || croak "No population here";
my $output_size = shift || @$pop; # Defaults to pop size
my @ops = @{$self->{_ops}};
#Select for breeding
lib/Algorithm/Evolutionary/Op/CX.pm view on Meta::CPAN
use strict;
use warnings;
use lib qw( ../../../../lib ); # mainly to avoid syntax errors when saving
=head1 NAME
Algorithm::Evolutionary::Op::CX (Cycle crossover) - 2-point crossover operator; Builds offspring in such a way
that each gene comes from one of the parents. Preserves the absolute position of the elements
in the parent sequence
=head1 SYNOPSIS
my $op4 = new Algorithm::Evolutionary::Op::CX 3;
my $indi = new Algorithm::Evolutionary::Individual::Vector 10;
my $indi2 = $indi->clone();
my $indi3 = $indi->clone();
$op3->apply( $indi2, $indi3 );
=head1 Base Class
L<Algorithm::Evolutionary::Op::Base|Algorithm::Evolutionary::Op::Base>
=head1 DESCRIPTION
Cycle Crossover operator for a GA. It is applied to chromosomes that are
a permutation of each other; even as the class it applies to is
L<Algorithm::Evolutionary::Individual::Vector>, it will issue lots of
"La jodimos!" messages if the parents do not fulfill this condition.
Some information on this operator can be obtained from
L<this
evolutionary computation tutorial|http://www.cs.bham.ac.uk/~rmp/slide_book/node4.html#SECTION00444300000000000000>
=head1 METHODS
=cut
package Algorithm::Evolutionary::Op::CX;
lib/Algorithm/Evolutionary/Op/CX.pm view on Meta::CPAN
Applies Algorithm::Evolutionary::Op::CX operator to a "Chromosome", a bitstring, really. Can be
applied only to I<victims> with the C<_bitstring> instance variable; but
it checks before application that both operands are of type
L<Individual::Vector|Algorithm::Evolutionary::Individual::Vector>.
=cut
sub apply ($$;$){
my $self = shift;
my $p1 = shift || croak "No victim here!"; #first parent
my $p2 = shift || croak "No victim here!"; #second parent
my $child=$p1->clone(); #Child
my $i; #Iterator
my $j; #Iterator
my $changed;
#Check parents type and size
croak "Incorrect type ".(ref $p1) if !$self->check($p1);
croak "Incorrect type ".(ref $p2) if !$self->check($p2);
croak "Algorithm::Evolutionary::Op::CX Error: Parents don't have the same size " if ($p1->length() != $p2->length() );
my $leng=$p1->length(); #Chrom length
my $no='x';#-( $leng );#Uninitialized gene mark
#Init child
for ($i=0;$i < $leng; $i++)
{ $child->Atom($i, $no);}
lib/Algorithm/Evolutionary/Op/CX.pm view on Meta::CPAN
last;
}
}
#Look if the next element in cycle was found
if ($found) {
$child->Atom($found, $p1->Atom($found));
# print "Found $found valor ", $child->Atom($found), "\n";
$i=$found;
$changed++;
}
else { #End of the cycle, get the genes from the second parent
$child->Atom(0, $p1->Atom(0) ); $changed++;
for ($i=1;( $i < $leng ) && ( $changed < $leng ) ; $i++) {
if ($child->Atom($i) eq $no ) {
# print "Cambiando $i valor ", $p2->Atom($i), "\n";
$child->Atom($i,$p2->Atom($i));
$changed++;
}
}
}
}#End-while
lib/Algorithm/Evolutionary/Op/CanonicalGA.pm view on Meta::CPAN
=head1 Base Class
L<Algorithm::Evolutionary::Op::Base|Algorithm::Evolutionary::Op::Base>
=head1 DESCRIPTION
The canonical classical genetic algorithm evolves a population of
bitstrings until they reach the optimum fitness. It performs mutation
on the bitstrings by flipping a single bit, crossover interchanges a
part of the two parents.
The first operator should be unary (a la mutation) and the second
binary (a la crossover) they will be applied in turn to couples of the
population.
=head1 METHODS
=cut
package Algorithm::Evolutionary::Op::CanonicalGA;
lib/Algorithm/Evolutionary/Op/Canonical_GA_NN.pm view on Meta::CPAN
=head1 Base Class
L<Algorithm::Evolutionary::Op::Base|Algorithm::Evolutionary::Op::Base>
=head1 DESCRIPTION
The canonical classical genetic algorithm evolves a population of
bitstrings until they reach the optimum fitness. It performs mutation
on the bitstrings by flipping a single bit, crossover interchanges a
part of the two parents.
The first operator should be unary (a la mutation) and the second
binary (a la crossover) they will be applied in turn to couples of the
population.
This is a fast version of the canonical GA, useful for large
populations, since it avoids the expensive rank operation. Roulette
wheel selection, still, is kind of slow.
=head1 METHODS
lib/Algorithm/Evolutionary/Op/Crossover.pm view on Meta::CPAN
return $self;
}
=head2 apply( $chromsosome_1, $chromosome_2 )
Applies xover operator to a "Chromosome", a string, really. Can be
applied only to I<victims> with the C<_str> instance variable; but
it checks before application that both operands are of type
L<BitString|Algorithm::Evolutionary::Individual::String>.
Changes the first parent, and returns it. If you want to change both
parents at the same time, check L<QuadXOver|Algorithm::Evolutionary::Op::QuadXOver>
=cut
sub apply ($$$){
my $self = shift;
my $arg = shift || croak "No victim here!";
my $victim = clone( $arg );
my $victim2 = shift || croak "No victim here!";
my $minlen = ( length( $victim->{_str} ) > length( $victim2->{_str} ) )?
length( $victim2->{_str} ): length( $victim->{_str} );
lib/Algorithm/Evolutionary/Op/Inverover.pm view on Meta::CPAN
=head2 apply( $first, $second )
Applies Algorithm::Evolutionary::Op::Inverover operator to a
"Chromosome". Can be applied to anything with the Atom method.
=cut
sub apply ($$$){
my $self = shift;
my $p1 = shift || croak "No victim here!"; #first parent
my $p2 = shift || croak "No victim here!"; #second parent
my $child=$p1->clone(); #Clone S' (child) from First parent
my $i; #Iterator
#Check parents type and size
croak "Incorrect type ".(ref $p1) if !$self->check($p1);
croak "Incorrect type ".(ref $p2) if !$self->check($p2);
croak "Inver-over Error: Parents haven't sime size " if ($p1->length() != $p2->length() );
my $leng=$p1->length(); #Chrom length
#Select randomly a atom c from S' (child)
my $c=int( rand( $leng/2 ) );
my $c2; #The another atom c' (called c2)
#Build Algorithm::Evolutionary::Op::Inverover child
while ( 1 )
{
if (rand() <= $self->rate)
{ #Select c' (c2) from the remaining cities of S'(child)
$c2=int( rand( $leng - $c ) + $c);
$c2+=2 if (($c2 == $c+1) && ($c2 < $leng -2) );
}
else
{ #Assign to c' (c2) the 'next' atom to the atom c in the second parent
for ($c2=0;$c2 < $leng; $c2++)
{ last if ( $child->Atom($c) == $p2->Atom($c2) );}
$c2= ($c2+1) % $leng;
}
# print "\nc= $c c2= $c2 lneg= $leng atom(c2)=".$child->Atom($c2)." atom(c+1)=".$child->Atom(($c+1) % $leng)."\n";
#Check if finish
last if ( ($child->Atom($c2) == $child->Atom( ($c+1)% $leng) ) || ($c+1==$leng) );
# Inverse the section from the next atom of atom c to the atom c' (c2) in S' (child)
lib/Algorithm/Evolutionary/Op/QuadXOver.pm view on Meta::CPAN
my $op4 = new Algorithm::Evolutionary::Op::QuadXOver 1; #QuadXOver with 1 crossover points
=head1 Base Class
L<Algorithm::Evolutionary::Op::Base|Algorithm::Evolutionary::Op::Base>
=head1 DESCRIPTION
Crossover operator for a GA, takes args by reference and issues two
children from two parents
=head1 METHODS
=cut
package Algorithm::Evolutionary::Op::QuadXOver;
use lib qw( ../../.. );
our $VERSION = sprintf "%d.1%02d", q$Revision: 3.4 $ =~ /(\d+)\.(\d+)/g; # Hack for avoiding version mismatch
use Carp;
use base 'Algorithm::Evolutionary::Op::Crossover';
#Class-wide constants
our $APPLIESTO = 'Algorithm::Evolutionary::Individual::String';
our $ARITY = 2;
=head2 apply( $parent_1, $parent_2 )
Same as L<Algorithm::Evolutionary::Op::Crossover>, but changes
parents, does not return anything; that is, $parent_1 and $parent_2
interchange genetic material.
=cut
sub apply ($$){
my $self = shift;
my $victim = shift || croak "No victim here!";
my $victim2 = shift || croak "No victim here!";
# croak "Incorrect type ".(ref $victim) if !$self->check($victim);
# croak "Incorrect type ".(ref $victim2) if !$self->check($victim2);
lib/Algorithm/Evolutionary/Op/Quad_Crossover_Diff.pm view on Meta::CPAN
my $op4 = new Algorithm::Evolutionary::Op::Quad_Crossover_Diff 1; #Quad_Crossover_Diff with 1 crossover points
=head1 Base Class
L<Algorithm::Evolutionary::Op::Base|Algorithm::Evolutionary::Op::Base>
=head1 DESCRIPTION
Crossover operator for a GA, takes args by reference and issues two
children from two parents
=head1 METHODS
=cut
package Algorithm::Evolutionary::Op::Quad_Crossover_Diff;
use lib qw( ../../.. );
our $VERSION = sprintf "%d.1%02d", q$Revision: 1.2 $ =~ /(\d+)\.(\d+)/g; # Hack for avoiding version mismatch
use Carp;
use base 'Algorithm::Evolutionary::Op::Crossover';
#Class-wide constants
our $APPLIESTO = 'Algorithm::Evolutionary::Individual::String';
our $ARITY = 2;
=head2 apply( $parent_1, $parent_2 )
Same as L<Algorithm::Evolutionary::Op::Crossover>, but changes
parents, does not return anything; that is, $parent_1 and $parent_2
interchange genetic material.
=cut
sub apply ($$){
my $self = shift;
my $victim = shift || croak "No victim here!";
my $victim2 = shift || croak "No victim here!";
# croak "Incorrect type ".(ref $victim) if !$self->check($victim);
# croak "Incorrect type ".(ref $victim2) if !$self->check($victim2);
lib/Algorithm/Evolutionary/Op/Tournament_Selection.pm view on Meta::CPAN
my $selector = new Algorithm::Evolutionary::Op::Tournament_Selection $tournamentSize;
my @newPop = $selector->apply( @pop ); #Creates a new population from old
=head1 Base Class
L<Algorithm::Evolutionary::Op::Selector>
=head1 DESCRIPTION
One of the possible selectors used for selecting the pool of individuals
that are going to be the parents of the following generation. Takes a
set of individuals randomly out of the population, and select the best.
=head1 METHODS
=cut
package Algorithm::Evolutionary::Op::Tournament_Selection;
use Carp;
lib/Algorithm/Evolutionary/Op/Uniform_Crossover.pm view on Meta::CPAN
use strict;
use warnings;
=head1 NAME
Algorithm::Evolutionary::Op::Uniform_Crossover - interchanges a set of atoms
from one parent to the other.
=head1 SYNOPSIS
#Create from XML description using EvoSpec
my $xmlStr3=<<EOC;
<op name='Uniform_Crossover' type='binary' rate='1'>
<param name='numPoints' value='3' /> #Max is 2, anyways
</op>
EOC
my $op3 = Algorithm::Evolutionary::Op::Base->fromXML( $xmlStr3 );
lib/Algorithm/Evolutionary/Op/Uniform_Crossover.pm view on Meta::CPAN
return $self;
}
=head2 apply( $chromsosome_1, $chromosome_2 )
Applies xover operator to a "Chromosome", a string, really. Can be
applied only to I<victims> with the C<_str> instance variable; but
it checks before application that both operands are of type
L<String|Algorithm::Evolutionary::Individual::String>.
Changes the first parent, and returns it. If you want to change both
parents at the same time, check
L<QuadXOver|Algorithm::Evolutionary::Op::QuadXOver>
=cut
sub apply ($$$){
my $self = shift;
my $arg = shift || croak "No victim here!";
my $victim = clone( $arg );
my $victim2 = shift || croak "No victim here!";
my $min_length = ( $victim->size() > $victim2->size() )?
lib/Algorithm/Evolutionary/Op/Uniform_Crossover_Diff.pm view on Meta::CPAN
sub new {
my $class = shift;
my $hash = { numPoints => shift || 1 };
croak "Less than 1 points to cross"
if $hash->{'numPoints'} < 1;
my $priority = shift || 1;
my $self = Algorithm::Evolutionary::Op::Base::new( $class, $priority, $hash );
return $self;
}
=head2 apply( $parent_1, $parent_2 )
Same as L<Algorithm::Evolutionary::Op::Uniform_Crossover>, but making
sure that what is interchanged is different.
=cut
sub apply ($$){
my $self = shift;
my $arg = shift || croak "No victim here!";
my $arg2 = shift || croak "No victim here!";
( run in 0.300 second using v1.01-cache-2.11-cpan-4d50c553e7e )