Algorithm-Evolutionary
view release on metacpan or search on metacpan
lib/Algorithm/Evolutionary/Experiment.pm view on Meta::CPAN
sub new ($$$$;$) {
my $class = shift;
my $self = { _pop => [] };
if ( index ( ref $_[0], 'Algorithm::Evolutionary') == -1 ) {
#If the first arg is not an algorithm, create one
my $popSize = shift || carp "Pop size = 0, can't create\n";
my $indiType = shift || carp "Empty individual class, can't create\n";
my $indiSize = shift || carp "Empty individual size, no reasonable default, can't create\n";
for ( my $i = 0; $i < $popSize; $i ++ ) {
my $indi = Algorithm::Evolutionary::Individual::Base::new( $indiType,
{ length => $indiSize } );
$indi->randomize();
push @{$self->{_pop}}, $indi;
}
};
@_ || croak "Can't find an algorithm";
push @{$self->{_algo}}, @_;
bless $self, $class;
return $self
}
lib/Algorithm/Evolutionary/Fitness/ECC.pm view on Meta::CPAN
=head1 SYNOPSIS
my $number_of_codewords = 10;
my $min_distance = 1;
my $p_peaks = Algorithm::Evolutionary::Fitness::ECC->new( $number_of_codewords, $min_distance );
=head1 DESCRIPTION
Extracted from article "Effects of scale-free and small-world topologies on binary coded self-adaptive CEA", by Giacobini et al [Ga]. Quoting:
" The ECC problem was presented in
[MW]. We will consider a three-tuple (n, M, d), where n is the length of each codeword
(number of bits), M is the number of codewords, and d is the minimum Hamming
distance between any pair of codewords. Our objective will be to find a code which
has a value for d as large as possible (reflecting greater tolerance to noise and errors),
given previously fixed values for n and M . The problem we have studied is a simplified
version of that in [MW]. In our case we search half of the codewords (M/2) that will
compose the code, and the other half is made up by the complement of the codewords
computed by the algorithm"
[Ga] Mario Giacobini, Mike Preuss, Marco Tomassini: Effects of Scale-Free and Small-World Topologies on Binary Coded Self-adaptive CEA. EvoCOP 2006: 86-98.
lib/Algorithm/Evolutionary/Fitness/ECC.pm view on Meta::CPAN
=cut
sub ecc {
my $self = shift;
my $string = shift || croak "Can't work with a null string";
my $cache = $self->{'_cache'};
if ( $cache->{$string} ) {
return $cache->{$string};
}
my $length = length($string)/$self->{'number_of_codewords'};
my @codewords = ( $string =~ /.{$length}/gs );
my $distance;
for ( my $i = 0; $i <= $#codewords; $i ++ ) {
for ( my $j = $i+1; $j <= $#codewords; $j ++ ) {
my $this_distance = hamming( $codewords[$i], $codewords[$j] );
$distance += 1/(1+$this_distance*$this_distance);
}
}
$cache->{$string} = 1/$distance;
return $cache->{$string};
lib/Algorithm/Evolutionary/Fitness/Knapsack.pm view on Meta::CPAN
my $cache = $self->{'_cache'};
if ( $cache->{$string} ) {
return $cache->{$string};
}
my $profit=0.0;
my $weight=0.0;
my @profits = @{$self->{'profits'}};
my @weights = @{$self->{'weights'}};
for (my $i=0 ; $i < length($string); $i++) { #Compute weight
my $this_bit=substr ($string, $i, 1);
if ($this_bit == 1) {
$profit += $profits[$i];
$weight += $weights[$i];
}
}
if ($weight > $self->{'capacity'}) { # Apply penalty
my $penalty = $self->{'rho'} * ($weight - $self->{'capacity'});
lib/Algorithm/Evolutionary/Fitness/MMDP.pm view on Meta::CPAN
=cut
sub mmdp {
my $self = shift;
my $string = shift;
my $cache = $self->{'_cache'};
if ( $cache->{$string} ) {
return $cache->{$string};
}
my $fitness = 0;
for ( my $i = 0; $i < length($string); $i+= BLOCK_SIZE ) {
my $block = substr( $string, $i, BLOCK_SIZE );
my $ones = grep ( /1/, split(//,$block));
$fitness += $unitation[$ones];
}
$cache->{$string} = $fitness;
return $fitness;
}
=head1 Copyright
lib/Algorithm/Evolutionary/Fitness/Royal_Road.pm view on Meta::CPAN
my $self = shift;
my $string = shift;
my $cache = $self->{'_cache'};
if ( $cache->{$string} ) {
return $cache->{$string};
}
my $fitness = 0;
my $block_size = $self->{'_block_size'};
for ( my $i = 0; $i < length( $string ) / $block_size; $i++ ) {
my $block = 0;
if ( length( substr( $string, $i*$block_size, $block_size )) == $block_size ) {
$block=1;
for ( my $j = 0; $j < $block_size; $j++ ) {
$block &= substr( $string, $i*$block_size+$j, 1 );
}
}
( $fitness += $block_size ) if $block;
}
$cache->{$string} = $fitness;
return $cache->{$string};
lib/Algorithm/Evolutionary/Fitness/Trap.pm view on Meta::CPAN
sub trap {
my $self = shift;
my $string = shift;
my $cache = $self->{'_cache'};
if ( $cache->{$string} ) {
return $cache->{$string};
}
my $l = $self->{'l'};
my $z = $self->{'z'};
my $total = 0;
for ( my $i = 0; $i < length( $string); $i+= $l ) {
my $substr = substr( $string, $i, $l );
my $key = $substr;
if ( !$cache->{$substr} ) {
my $num_ones = 0;
while ( $substr ) {
$num_ones += chop( $substr );
}
if ( $num_ones <= $z ) {
$cache->{$key} = $self->{'a'}*($z-$num_ones)/$z;
} else {
lib/Algorithm/Evolutionary/Individual/BitString.pm view on Meta::CPAN
=head1 NAME
Algorithm::Evolutionary::Individual::BitString - Classic bitstring individual for evolutionary computation; usually called I<chromosome>
=head1 SYNOPSIS
use Algorithm::Evolutionary::Individual::BitString;
my $indi = new Algorithm::Evolutionary::Individual::BitString 10 ; # Build random bitstring with length 10
# Each element in the range 0 .. 1
my $indi3 = new Algorithm::Evolutionary::Individual::BitString;
$indi3->set( { length => 20 } ); #Sets values, but does not build the string
$indi3->randomize(); #Creates a random bitstring with length as above
print $indi3->Atom( 7 ); #Returns the value of the 7th character
$indi3->Atom( 3 ) = 1; #Sets the value
$indi3->addAtom( 1 ); #Adds a new character to the bitstring at the end
my $size = $indi3->size(); #Common interface to all individuals, should return 21
my $indi4 = Algorithm::Evolutionary::Individual::BitString->fromString( '10110101'); #Creates an individual from that string
my $indi5 = $indi4->clone(); #Creates a copy of the individual
lib/Algorithm/Evolutionary/Individual/BitString.pm view on Meta::CPAN
use base 'Algorithm::Evolutionary::Individual::String';
use constant MY_OPERATORS => ( Algorithm::Evolutionary::Individual::String::MY_OPERATORS,
qw(Algorithm::Evolutionary::Op::BitFlip Algorithm::Evolutionary::Op::Mutation ));
use Algorithm::Evolutionary::Utils qw(decode_string);
=head1 METHODS
=head2 new( $length )
Creates a new random bitstring individual, with fixed initial length, and
uniform distribution of bits. Options as in L<Algorithm::Evolutionary::Individual::String>
=cut
sub new {
my $class = shift;
my $chars = [ '0', '1' ];
my $self =
Algorithm::Evolutionary::Individual::String::new( $class, $chars, @_ );
return $self;
lib/Algorithm/Evolutionary/Individual/Bit_Vector.pm view on Meta::CPAN
=head1 NAME
Algorithm::Evolutionary::Individual::Bit_Vector - Classic bitstring individual for evolutionary computation;
usually called chromosome, and using a different implementation from Algorithm::Evolutionary::Individual::BitString
=head1 SYNOPSIS
use Algorithm::Evolutionary::Individual::BitVector;
my $indi = new Algorithm::Evolutionary::Individual::Bit_Vector 10 ; # Build random bitstring with length 10
# Each element in the range 0 .. 1
my $indi3 = new Algorithm::Evolutionary::Individual::Bit_Vector;
$indi3->set( { length => 20 } ); #Sets values, but does not build the string
$indi3->randomize(); #Creates a random bitstring with length as above
print $indi3->Atom( 7 ); #Returns the value of the 7th character
$indi3->Atom( 3 ) = 1; #Sets the value
$indi3->addAtom( 1 ); #Adds a new character to the bitstring at the end
my $indi4 = Algorithm::Evolutionary::Individual::Bit_Vector->fromString( '10110101'); #Creates an individual from that string
my $indi5 = $indi4->clone(); #Creates a copy of the individual
lib/Algorithm/Evolutionary/Individual/Bit_Vector.pm view on Meta::CPAN
use base 'Algorithm::Evolutionary::Individual::Base';
use constant MY_OPERATORS => ( qw(Algorithm::Evolutionary::Op::BitFlip Algorithm::Evolutionary::Op::Mutation ));
=head1 METHODS
=head2 new( $arg )
Creates a new bitstring individual. C<$arg> can be either { length =>
$length} or { string => [binary string] }. With no argument, a
length of 16 is given by default.
=cut
sub new {
my $class = shift;
my $self = Algorithm::Evolutionary::Individual::Base::new( $class );
my $arg = shift || { length => 16};
if ( $arg =~ /^\d+$/ ) { #It's a number
$self->{'_bit_vector'} = _create_bit_vector( $arg );
} elsif ( $arg->{'length'} ) {
$self->{'_bit_vector'} = _create_bit_vector( $arg->{'length'} );
} elsif ( $arg->{'string'} ) {
$self->{'_bit_vector'} =
Bit::Vector->new_Bin( length($arg->{'string'}), $arg->{'string'} );
}
croak "Incorrect creation options" if !$self->{'_bit_vector'};
return $self;
}
sub _create_bit_vector {
my $length = shift || croak "No length!";
my $rander = new String::Random;
my $hex_string = $rander->randregex("[0-9A-F]{".int($length/4)."}");
return Bit::Vector->new_Hex( $length, $hex_string );
}
sub TIEARRAY {
my $class = shift;
my $self = { _bit_vector => Bit::Vector->new_Bin(scalar( @_), join("",@_)) };
bless $self, $class;
return $self;
}
=head2 Atom
lib/Algorithm/Evolutionary/Individual/Bit_Vector.pm view on Meta::CPAN
sub UNSHIFT {
my $self = shift;
my $new_vector = Bit::Vector->new_Bin(scalar(@_), join("",@_));
$self->{'_bit_vector'} = Bit::Vector->Concat_List( $new_vector, $self->{'_bit_vector'}) ;
}
sub POP {
my $self = shift;
my $bit_vector = $self->{'_bit_vector'};
my $length = $bit_vector->Size();
my $pop = $bit_vector->lsb();
$self->{'_bit_vector'}->Delete(0,1);
$self->{'_bit_vector'}->Resize($length-1);
return $pop;
}
sub SHIFT {
my $self = shift;
my $length = $self->{'_bit_vector'}->Size();
my $bit = $self->{'_bit_vector'}->shift_left('0');
$self->{'_bit_vector'}->Reverse( $self->{'_bit_vector'});
$self->{'_bit_vector'}->Resize($length-1);
$self->{'_bit_vector'}->Reverse( $self->{'_bit_vector'});
return $bit;
}
sub SPLICE {
my $self = shift;
my $offset = shift;
my $bits = shift;
my $new_vector;
lib/Algorithm/Evolutionary/Individual/Bit_Vector.pm view on Meta::CPAN
} else {
$self->{'_bit_vector'}->Interval_Substitute( Bit::Vector->new(0), $size-$offset-$bits, $bits,
0, 0 );
}
return split(//,$slice->to_Bin());
}
sub FETCHSIZE {
my $self = shift;
return length( $self->{'_bit_vector'}->Size() );
}
=head2 Copyright
This file is released under the GPL. See the LICENSE file included in this distribution,
or go to http://www.fsf.org/licenses/gpl.txt
CVS Info: $Date: 2010/12/19 21:39:12 $
$Header: /media/Backup/Repos/opeal/opeal/Algorithm-Evolutionary/lib/Algorithm/Evolutionary/Individual/Bit_Vector.pm,v 3.1 2010/12/19 21:39:12 jmerelo Exp $
lib/Algorithm/Evolutionary/Individual/String.pm view on Meta::CPAN
=head1 NAME
Algorithm::Evolutionary::Individual::String - A character string to be evolved. Useful mainly in word games
=head1 SYNOPSIS
use Algorithm::Evolutionary::Individual::String;
my $indi = new Algorithm::Evolutionary::Individual::String ['a'..'z'], 10;
# Build random bitstring with length 10
my $indi3 = new Algorithm::Evolutionary::Individual::String;
$indi3->set( { length => 20,
chars => ['A'..'Z'] } ); #Sets values, but does not build the string
$indi3->randomize(); #Creates a random bitstring with length as above
print $indi3->Atom( 7 ); #Returns the value of the 7th character
$indi3->Atom( 3, 'Q' ); #Sets the value
$indi3->addAtom( 'K' ); #Adds a new character to the bitstring at the end
my $indi4 = Algorithm::Evolutionary::Individual::String->fromString( 'esto es un string'); #Creates an individual from that string
my $indi5 = $indi4->clone(); #Creates a copy of the individual
my @array = qw( a x q W z ñ); #Tie a String individual
lib/Algorithm/Evolutionary/Individual/String.pm view on Meta::CPAN
use constant MY_OPERATORS => qw(Algorithm::Evolutionary::Op::Crossover
Algorithm::Evolutionary::Op::QuadXOver
Algorithm::Evolutionary::Op::StringRand
Algorithm::Evolutionary::Op::Permutation
Algorithm::Evolutionary::Op::IncMutation
Algorithm::Evolutionary::Op::ChangeLengthMutation );
=head2 new
Creates a new random string, with fixed initial length, and uniform
distribution of characters along the character class that is
defined. However, this character class is just used to generate new
individuals and in mutation operators, and the validity is not
enforced unless the client class does it
=cut
sub new {
my $class = shift;
my $self = Algorithm::Evolutionary::Individual::Base::new( $class );
$self->{'_chars'} = shift || ['a'..'z'];
$self->{'_length'} = shift || 10;
$self->randomize();
return $self;
}
sub TIEARRAY {
my $class = shift;
my $self = { _str => join("",@_),
_length => scalar( @_ ),
_fitness => undef };
bless $self, $class;
return $self;
}
=head2 randomize
Assigns random values to the elements
=cut
sub randomize {
my $self = shift;
$self->{'_str'} = ''; # Reset string
for ( my $i = 0; $i < $self->{'_length'}; $i ++ ) {
$self->{'_str'} .= $self->{'_chars'}[ rand( @{$self->{'_chars'}} ) ];
}
}
=head2 addAtom
Adds an atom at the end
=cut
lib/Algorithm/Evolutionary/Individual/String.pm view on Meta::CPAN
=cut
sub fromString {
my $class = shift;
my $str = shift;
my $self = Algorithm::Evolutionary::Individual::Base::new( $class );
$self->{_str} = $str;
my %chars;
map ( $chars{$_} = 1, split(//,$str) );
my @chars = keys %chars;
$self->{_length} = length( $str );
$self->{'_chars'} = \@chars;
return $self;
}
=head2 from_string
Similar to a copy ctor; creates a bitstring individual from a string.
=cut
sub from_string {
my $class = shift;
my $chars = shift;
my $str = shift;
my $self = Algorithm::Evolutionary::Individual::Base::new( $class );
$self->{'_chars'} = $chars;
$self->{'_str'} = $str;
$self->{'_length'} = length( $str );
return $self;
}
=head2 clone
Similar to a copy ctor: creates a new individual from another one
=cut
sub clone {
my $indi = shift || croak "Indi to clone missing ";
my $self = { '_fitness' => undef };
bless $self, ref $indi;
for ( qw( _chars _str _length) ) {
$self->{ $_ } = $indi->{$_};
}
return $self;
}
=head2 asString
Returns the individual as a string with the fitness as a suffix.
lib/Algorithm/Evolutionary/Individual/String.pm view on Meta::CPAN
$self->{_str}.= join("", @_ );
}
sub UNSHIFT {
my $self = shift;
$self->{_str} = join("", @_ ).$self->{_str} ;
}
sub POP {
my $self = shift;
my $pop = substr( $self->{_str}, length( $self->{_str} )-1, 1 );
substr( $self->{_str}, length( $self->{_str} ) -1, 1 ) = '';
return $pop;
}
sub SHIFT {
my $self = shift;
my $shift = substr( $self->{_str}, 0, 1 );
substr( $self->{_str}, 0, 1 ) = '';
return $shift;
}
sub SPLICE {
my $self = shift;
my $offset = shift;
my $length = shift || length( $self->{'_str'} - $offset );
my $sub_string = substr( $self->{_str}, $offset, $length );
# if ( @_ ) {
substr( $self->{_str}, $offset, $length ) = join("", @_ );
# }
return split(//,$sub_string);
}
sub FETCHSIZE {
my $self = shift;
return length( $self->{_str} );
}
=head2 size()
Returns length of the string that stores the info; overloads abstract base method.
=cut
sub size {
my $self = shift;
return length($self->{_str}); #Solves ambiguity
}
=head2 as_string()
Returns the string used as internal representation
=cut
sub as_string {
my $self = shift;
lib/Algorithm/Evolutionary/Individual/Vector.pm view on Meta::CPAN
use strict; #-*-cperl-*-
use warnings;
=head1 NAME
Algorithm::Evolutionary::Individual::Vector - Array as an individual for evolutionary computation
=head1 SYNOPSIS
use Algorithm::Evolutionary::Individual::Vector;
my $indi = new Algorithm::Evolutionary::Individual::Vector 10 ; # Build random vector individual with length 10
# Each element in the range 0 .. 1
my $indi2 = new Algorithm::Evolutionary::Individual::Vector 20, -5, 5; #Same, with range between -5 and 5
#Creating a vector step by step. In Perl, there's always more than one way of doing it
my $indi3 = new Algorithm::Evolutionary::Individual::Vector;
$indi3->set( {length => 20,
rangestart => -5,
rangeend => 5 } ); #Sets values, but does not build the array
$indi3->randomize(); #Creates an array using above parameters
print $indi3->Atom( 7 ); #Returns the value of the 7th character
$indi3->Atom( 3 ) = '2.35'; #Sets the value
$indi3->addAtom( 7.5 ); #Adds a new component to the array at the end
lib/Algorithm/Evolutionary/Individual/Vector.pm view on Meta::CPAN
use Carp;
use Exporter;
our ($VERSION) = ( '$Revision: 3.2 $ ' =~ / (\d+\.\d+)/ );
use base 'Algorithm::Evolutionary::Individual::Base';
=head1 METHODS
=head2 new( [$length = 10] [, $start_of_range = 0] [, $end_of_range = 1] )
Creates a new random array individual, with fixed initial length, and uniform distribution
of values within a range
=cut
sub new {
my $class = shift;
my $self;
$self->{_length} = shift || 10;
$self->{_array} = ();
$self->{_rangestart} = shift || 0;
$self->{_rangeend } = shift || 1;
$self->{_fitness} = undef;
bless $self, $class;
$self->randomize();
return $self;
}
=head2 size()
Returns vector size (dimension)
=cut
sub size {
my $self = shift;
return $self->{'_length'};
}
sub TIEARRAY {
my $class = shift;
my $self = { _array => \@_,
_length => scalar( @_ ),
_fitness => undef };
bless $self, $class;
return $self;
}
=head2 set( $ref_to_hash )
Sets values of an individual; takes a hash as input. The array is
initialized to a null array, and the start and end range are
initialized by default to 0 and 1
lib/Algorithm/Evolutionary/Individual/Vector.pm view on Meta::CPAN
=head2 randomize()
Assigns random values to the elements
=cut
sub randomize {
my $self = shift;
my $range = $self->{_rangeend} - $self->{_rangestart};
for ( my $i = 0; $i < $self->{_length}; $i++ ) {
push @{$self->{_array}}, rand( $range ) + $self->{_rangestart};
}
}
=head2 Atom
Gets or sets the value of an atom
=cut
lib/Algorithm/Evolutionary/Individual/Vector.pm view on Meta::CPAN
=head2 addAtom
Adds an atom at the end
=cut
sub addAtom{
my $self = shift;
my $atom = shift || croak "No atom to add\n";
push( @{$self->{_array}}, $atom );
$self->{_length}++;
}
sub PUSH {
my $self = shift;
push( @{$self->{_array}}, @_ );
$self->{_length}++;
}
sub UNSHIFT {
my $self = shift;
unshift( @{$self->{_array}}, @_ );
$self->{_length}++;
}
sub POP {
my $self = shift;
return pop ( @{$self->{_array}} );
$self->{_length}--;
}
sub SHIFT {
my $self = shift;
return shift @{$self->{_array}} ;
$self->{_length}--;
}
sub SPLICE {
my $self = shift;
splice( @{$self->{_array}}, shift, shift, @_ );
}
sub FETCHSIZE {
my $self = shift;
return @{$self->{_array}} -1;
}
=head2 length()
Returns the number of atoms in the individual
=cut
sub length {
my $self = shift;
return scalar @{$self->{_array}};
}
=head2 fromString( $string )
Similar to a copy ctor; creates a vector individual from a string composed of
stuff separated by a separator
=cut
lib/Algorithm/Evolutionary/Individual/Vector.pm view on Meta::CPAN
=head2 clone()
Similar to a copy ctor: creates a new individual from another one
=cut
sub clone {
my $indi = shift || croak "Indi to clone missing ";
my $self = { _fitness => undef,
_length => $indi->{_length} };
$self->{_array} = ();
push(@{$self->{_array}}, @{$indi->{_array}});
bless $self, ref $indi;
die "Something is wrong " if scalar( @{$self->{_array}} ) > scalar( @{$indi->{_array}} );
return $self;
}
=head2 asString()
lib/Algorithm/Evolutionary/Op/Animated_GIF_Output.pm view on Meta::CPAN
use Carp;
our $VERSION = sprintf "%d.%03d", q$Revision: 1.5 $ =~ /(\d+)\.(\d+)/g;
use base 'Algorithm::Evolutionary::Op::Base';
use GD::Image;
sub new {
my $class = shift;
my $hash = shift || croak "No default values for length ";
my $self = Algorithm::Evolutionary::Op::Base::new( __PACKAGE__, 1, $hash );
$hash->{'pixels_per_bit'} = $hash->{'pixels_per_bit'} || 1;
$self->{'_image'} = GD::Image->new($hash->{'length'}*$hash->{'pixels_per_bit'},
$hash->{'number_of_strings'}*$hash->{'pixels_per_bit'});
$self->{'_length'} = $hash->{'length'};
$self->{'_pixels_per_bit'} = $hash->{'pixels_per_bit'};
$self->{'_white'} = $self->{'_image'}->colorAllocate(0,0,0); #background color
$self->{'_black'} = $self->{'_image'}->colorAllocate(255,255,255);
$self->{'_gifdata'} = $self->{'_image'}->gifanimbegin;
$self->{'_gifdata'} .= $self->{'_image'}->gifanimadd; # first frame
return $self;
}
sub apply {
my $self = shift;
my $population_hashref=shift;
my $frame = GD::Image->new($self->{'_image'}->getBounds);
my $ppb = $self->{'_pixels_per_bit'};
my $l=0;
for my $i (@$population_hashref) {
my $bit_string = $i->{'_str'};
for my $c ( 0..($self->{'_length'}-1) ) {
my $bit = substr( $bit_string, $c, 1 );
if ( $bit ) {
for my $p ( 1..$ppb ) {
for my $q (1..$ppb ) {
$frame->setPixel($l*$ppb+$q, $c*$ppb+$p,
$self->{'_black'})
}
}
}
}
lib/Algorithm/Evolutionary/Op/Animated_GIF_Output.pm view on Meta::CPAN
=head1 NAME
Algorithm::Evolutionary::Op::Animated_GIF_Output - Creates an animated GIF, a frame per generation. Useful for binary strings.
=head1 SYNOPSIS
my $pp = new Algorithm::Evolutionary::Op::Animated_GIF_Output;
my @pop;
my $length = 8;
my $number_of_strings = 10;
for ( 1..$number_of_strings ) {
my $indi= new Algorithm::Evolutionary::Individual::String [0,1], $length;
push @pop, $indi;
}
$pp->apply( \@pop );
my $options = { pixels_per_bit => 2,
length => $length,
number_of_strings => $number_of_strings };
$pp = new Algorithm::Evolutionary::Op::Animated_GIF_Output $options
$pp->apply( \@pop );
$pp->terminate();
my $output_gif = $pp->output(); # Prints final results
=head1 DESCRIPTION
Saves each generation as a frame in an animated GIF. Every individual
gets a line of the number of pixels specified, and bits set to "1" are
represented via black pixels or fat pixels. By default, a bit takes a
single pixel.
=head1 INTERFACE
=head2 new( [$hash_ref] )
C<$hash_ref> is a hashref with 3 options: C<pixels_per_bit>, which
defaults to 1, and C<length> and C<number_of_strings> which have no
default and need to be set in advance to set up the GIF before any
population individual is seen.
=head2 apply( $population_hashref )
Applies the single-member printing function to every population member
=head2 terminate()
Finish the setup of the animated GIF.
lib/Algorithm/Evolutionary/Op/CX.pm view on Meta::CPAN
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);}
my %visto;
map( $visto{$_}++,@{$p1->{_array}} );
#Build child
# print "CX \$leng = $leng\n";
$changed=$i=0;
lib/Algorithm/Evolutionary/Op/ChangeLengthMutation.pm view on Meta::CPAN
use strict;
use warnings;
=head1 NAME
Algorithm::Evolutionary::Op::ChangeLengthMutation - Increases/decreases by one atom the length of the string
=head1 SYNOPSIS
my $xmlStr2=<<EOC;
<op name='ChangeLengthMutation' type='unary' rate='0.5' />
EOC
my $ref2 = XMLin($xmlStr2);
my $op2 = Algorithm::Evolutionary::Op::Base->fromXML( $ref2 );
print $op2->asXML(), "\n*Arity ", $op->arity(), "\n";
my $op = new Algorithm::Evolutionary::Op::ChangeLengthMutation 1, 0.5, 0.5; #Create from scratch
=head1 Base Class
L<Algorithm::Evolutionary::Op::Base|Algorithm::Evolutionary::Op::Base>
=head1 DESCRIPTION
Increases or decreases the length of a string, by adding a random element, or
eliminating it.
=head1 METHODS
=cut
package Algorithm::Evolutionary::Op::ChangeLengthMutation;
our ($VERSION) = ( '$Revision: 3.1 $ ' =~ /(\d+\.\d+)/ );
lib/Algorithm/Evolutionary/Op/ChangeLengthMutation.pm view on Meta::CPAN
croak "Incorrect type ".(ref $victim) if ! $self->check( $victim );
#Select increment or decrement
my $total = $self->{_probplus} + $self->{_probminus};
my $rnd = rand( $total );
if ( $rnd < $self->{_probplus} ) { #Incrementar
my $idx = rand( @{$victim->{_chars}} );
my $char = $victim->{_chars}[$idx];
$victim->addAtom( $char );
} else {
my $idx = rand( length($victim->{_str}) );
substr( $victim->{_str}, $idx, 1 ) ='';
}
$victim->Fitness(undef);
return $victim;
}
=head1 Copyright
This file is released under the GPL. See the LICENSE file included in this distribution,
or go to http://www.fsf.org/licenses/gpl.txt
lib/Algorithm/Evolutionary/Op/Creator.pm view on Meta::CPAN
=head1 SYNOPSIS
my $op = new Algorithm::Evolutionary::Op::Creator; #Creates empty op, with rate
my $xmlStr=<<EOC;
<op name='Creator' type='nullary'>
<param name='number' value='20' />
<param name='class' value='BitString' />
<param name='options'>
<param name='length' value='320 />
</param>
</op>
EOC
my $ref = XMLin($xmlStr); #This step is not really needed; only if it's going to be manipulated by another object
my $op = Algorithm::Evolutionary::Op::Base->fromXML( $ref ); #Takes a hash of parsed XML and turns it into an operator
print $op->asXML(); #print its back in XML shape
my $op2 = new Algorithm::Evolutionary::Op::Creator( 20, 'String', { chars => [a..j], length => '10' });
my @pop;
$op2->apply( \@pop ); #Generates population
=head1 DESCRIPTION
Base class for operators applied to Individuals and Populations and all the rest
=head1 METHODS
lib/Algorithm/Evolutionary/Op/Crossover.pm view on Meta::CPAN
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} );
my $pt1 = int( rand( $minlen ) );
my $range = 1 + int( rand( $minlen - $pt1 ) );
# print "Puntos: $pt1, $range \n";
croak "No number of points to cross defined" if !defined $self->{_numPoints};
if ( $self->{_numPoints} > 1 ) {
$range = int ( rand( length( $victim->{_str} ) - $pt1 ) );
}
substr( $victim->{_str}, $pt1, $range ) = substr( $victim2->{_str}, $pt1, $range );
$victim->{'_fitness'} = undef;
return $victim;
}
=head1 SEE ALSO
=over 4
lib/Algorithm/Evolutionary/Op/EDA_step.pm view on Meta::CPAN
=head2 reset( $population )
Start all over again by resetting the population
=cut
sub reset {
my $self = shift;
my $population = shift;
my $length = $population->[0]->size;
@$population = ();
my @alphabet = @{$self->{'_alphabet'}};
for ( my $p= 0; $p < $self->{'_population_size'}; $p++ ) {
my $string = '';
for ( my $i = 0; $i < $length; $i++ ) {
$string .= $alphabet[rand( @alphabet )];
}
my $new_one = Algorithm::Evolutionary::Individual::String->fromString( $string );
push @$population, $new_one;
}
}
=head2 apply( $population )
Applies the algorithm to the population, which should have
lib/Algorithm/Evolutionary/Op/EDA_step.pm view on Meta::CPAN
}
my @ranked_pop = sort { $b->{_fitness} <=> $a->{_fitness}; } @$pop;
#Eliminate
my $pringaos = @$pop * $self->{_replacementRate} ;
splice( @ranked_pop, -$pringaos );
#Check distribution of remaining pop
my $how_many = @ranked_pop;
my @occurrences;
my $length = $pop->[0]->size;
for my $p ( @ranked_pop ) {
for ( my $i = 0; $i < $length; $i++ ) {
if ( ! defined $occurrences[$i] ) {
$occurrences[$i] = {};
}
my $this_value = $p->Atom($i);
$occurrences[$i]->{$this_value}++;
}
}
my @wheel;
for ( my $i = 0; $i < $length; $i++ ) {
for my $k ( @{$self->{'_alphabet'}} ) {
if ( $occurrences[$i]->{$k} ) {
$occurrences[$i]->{$k} /= $how_many;
} else {
$occurrences[$i]->{$k} = 0.05; #Minimum to avoid stagnation
}
}
$wheel[$i] = new Algorithm::Evolutionary::Hash_Wheel $occurrences[$i];
}
#Generate new population
for ( my $p= 0; $p < $self->{'_population_size'} - $pringaos; $p++ ) {
my $string = '';
for ( my $i = 0; $i < $length; $i++ ) {
$string .= $wheel[$i]->spin;
}
my $new_one = Algorithm::Evolutionary::Individual::String->fromString( $string );
push @ranked_pop, $new_one;
}
@$pop = @ranked_pop; # Population is sorted
}
=head1 SEE ALSO
lib/Algorithm/Evolutionary/Op/FullAlgorithm.pm view on Meta::CPAN
#Or using the constructor
my $m = new Algorithm::Evolutionary::Op::Bitflip; #Changes a single bit
my $c = new Algorithm::Evolutionary::Op::Crossover; #Classical 2-point crossover
my $replacementRate = 0.3; #Replacement rate
my $popSize = 20;
my $selector = new Algorithm::Evolutionary::Op::RouletteWheel $popSize; #One of the possible selectors
my $onemax = sub {
my $indi = shift;
my $total = 0;
my $len = $indi->length();
my $i = 0;
while ($i < $len ) {
$total += substr($indi->{'_str'}, $i, 1);
$i++;
}
return $total;
};
my $generation =
new Algorithm::Evolutionary::Op::GeneralGeneration( $onemax, $selector, [$m, $c], $replacementRate );
my $g100 = new Algorithm::Evolutionary::Op::GenerationalTerm 10;
lib/Algorithm/Evolutionary/Op/Gene_Boundary_Crossover.pm view on Meta::CPAN
sub apply ($$$){
my $self = shift;
my $arg = shift || croak "No victim here!";
# my $victim = $arg->clone();
my $gene_size = $self->{'_gene_size'};
my $victim = clone( $arg );
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);
my $minlen = ( length( $victim->{_str} ) > length( $victim2->{_str} ) )?
length( $victim2->{_str} )/$gene_size: length( $victim->{_str} )/$gene_size;
croak "Crossover not possible" if ($minlen == 1);
my ($pt1, $range );
if ( $minlen == 2 ) {
$pt1 = $range = 1;
} else {
$pt1 = int( rand( $minlen - 1 ) );
# print "Puntos: $pt1, $range \n";
croak "No number of points to cross defined" if !defined $self->{_numPoints};
if ( $self->{_numPoints} > 1 ) {
$range = int ( 1 + rand( length( $victim->{_str} )/$gene_size - $pt1 - 1) );
} else {
$range = 1 + int( $minlen - $pt1 );
}
}
substr( $victim->{_str}, $pt1*$gene_size, $range*$gene_size )
= substr( $victim2->{_str}, $pt1*$gene_size, $range*$gene_size );
$victim->{'_fitness'} = undef;
return $victim;
}
lib/Algorithm/Evolutionary/Op/GeneralGeneration.pm view on Meta::CPAN
my $m = new Algorithm::Evolutionary::Op::Bitflip; #Changes a single bit
my $c = new Algorithm::Evolutionary::Op::Crossover; #Classical 2-point crossover
my $replacementRate = 0.3; #Replacement rate
use Algorithm::Evolutionary::Op::RouletteWheel;
my $popSize = 20;
my $selector = new Algorithm::Evolutionary::Op::RouletteWheel $popSize; #One of the possible selectors
use Algorithm::Evolutionary::Op::GeneralGeneration;
my $onemax = sub {
my $indi = shift;
my $total = 0;
for ( my $i = 0; $i < $indi->length(); $i ++ ) {
$total += substr( $indi->{_str}, $i, 1 );
}
return $total;
};
my @pop;
my $numBits = 10;
for ( 0..$popSize ) {
my $indi = new Algorithm::Evolutionary::Individual::BitString $numBits ; #Creates random individual
my $fitness = $onemax->( $indi );
$indi->Fitness( $fitness );
lib/Algorithm/Evolutionary/Op/IncMutation.pm view on Meta::CPAN
Issues an error if there is no C<_chars> array, which is needed for computing the next.
=cut
sub apply ($;$){
my $self = shift;
my $arg = shift || croak "No victim here!";
my $victim = clone( $arg );
croak "Incorrect type ".(ref $victim) if ! $self->check( $victim );
my $rnd = int (rand( length( $victim->{_str} ) ));
my $char = $victim->Atom( $rnd );
#Compute its place in the array
my $i = 0;
#Compute order in the array
croak "Can't do nuthin'; there's no alphabet in the victim" if @{$victim->{_chars}}< 0;
while ( ($victim->{_chars}[$i] ne $char )
&& ($i < @{$victim->{_chars}}) ) { $i++;};
#Generate next or previous
my $newpos = ( rand() > 0.5)?$i-1:$i+1;
$newpos = @{$victim->{_chars}}-1 if !$newpos;
lib/Algorithm/Evolutionary/Op/Inverover.pm view on Meta::CPAN
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)
lib/Algorithm/Evolutionary/Op/Mutation.pm view on Meta::CPAN
=head1 SYNOPSIS
use Algorithm::Evolutionary::Op::Mutation;
#Create from scratch
my $op = new Algorithm::Evolutionary::Op::Mutation (0.5 );
#All options
my $priority = 1;
my $mutation = new Algorithm::Evolutionary::Op::Mutation 1/$length, $priority;
=head1 Base Class
L<Algorithm::Evolutionary::Op::Base|Algorithm::Evolutionary::Op::Base>
=head1 DESCRIPTION
Mutation operator for a GA
=cut
lib/Algorithm/Evolutionary/Op/Mutation.pm view on Meta::CPAN
L<Algorithm::Evolutionary::Individual::BitString|Algorithm::Evolutionary::Individual::BitString>.
It returns the victim.
=cut
sub apply ($;$) {
my $self = shift;
my $arg = shift || croak "No victim here!";
my $victim = $arg->clone();
croak "Incorrect type ".(ref $victim) if ! $self->check( $victim );
for ( my $i = 0; $i < length( $victim->{_str} ); $i ++ ) {
if ( rand() < $self->{_mutRate} ) {
my $bit = $victim->Atom($i);
$victim->Atom($i, $bit?0:1 );
}
}
$victim->{'_fitness'} = undef ;
return $victim;
}
=head1 Copyright
lib/Algorithm/Evolutionary/Op/Permutation.pm view on Meta::CPAN
=head1 Base Class
L<Algorithm::Evolutionary::Op::Base>
=head1 DESCRIPTION
Class independent permutation operator; any individual that has the
C<_str> instance variable (like
L<Algorithm::Evolutionary::Individual::String> and
L<Algorithm::Evolutionary::Individual::BitString>) will have some
of its elements swapped. Each string of length l has l!
permutations; the C<max_iterations> parameter should not be higher
than that.
This kind of operator is used extensively in combinatorial
optimization problems. See, for instance,
@article{prins2004simple,
title={{A simple and effective evolutionary algorithm for the vehicle routing problem}},
author={Prins, C.},
journal={Computers \& Operations Research},
volume={31},
lib/Algorithm/Evolutionary/Op/QuadXOver.pm view on Meta::CPAN
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);
my $minlen = ( length( $victim->{_str} ) > length( $victim2->{_str} ) )?
length( $victim2->{_str} ): length( $victim->{_str} );
my $pt1 = 1+int( rand( $minlen - 1 ) ); # first crossover point shouldn't be 0
my $range;
if ( $self->{_numPoints} > 1 ) {
$range= 1 + int( rand( $minlen - $pt1 ) );
} else {
$range = $minlen - $pt1;
}
# print "Puntos: $pt1, $range \n";
my $str = $victim->{_str};
substr( $victim->{_str}, $pt1, $range ) = substr( $victim2->{_str}, $pt1, $range );
lib/Algorithm/Evolutionary/Op/Quad_Crossover_Diff.pm view on Meta::CPAN
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);
my $minlen = ( length( $victim->{_str} ) > length( $victim2->{_str} ) )?
length( $victim2->{_str} ): length( $victim->{_str} );
my @diffs;
for ( my $i = 0; $i < $minlen; $i ++ ) {
if ( substr( $victim2->{_str}, $i, 1 ) ne substr( $victim->{_str}, $i, 1 ) ) {
push @diffs, $i;
}
}
for ( my $i = 0; $i < $self->{_numPoints}; $i ++ ) {
if ( @diffs ) {
lib/Algorithm/Evolutionary/Op/StringRand.pm view on Meta::CPAN
$xmen->apply( $strChrom ) # will change 'acgt' into 'aagt' or
# 'aggt', for instance
=cut
sub apply ($;$){
my $self = shift;
my $arg = shift || croak "No victim here!";
my $victim = $arg->clone();
croak "Incorrect type ".(ref $victim) if ! $self->check( $victim );
my $rnd = int (rand( length( $victim->{_str} ) ));
my $char = $victim->Atom( $rnd );
#Compute its place in the array
my $i = 0;
#Compute order in the array
while ( ($victim->{_chars}[$i] ne $char )
&& ($i < @{$victim->{_chars}}) ) { $i++;};
#Generate next or previous
my $newpos = ( rand() > 0.5)?$i-1:$i+1;
$newpos = @{$victim->{_chars}}-1 if !$newpos;
$newpos = 0 if $newpos >= @{$victim->{_chars}};
lib/Algorithm/Evolutionary/Op/String_Mutation.pm view on Meta::CPAN
=head2 apply( $chromosome )
Applies mutation operator to a "Chromosome", a string, really.
=cut
sub apply ($;$){
my $self = shift;
my $arg = shift || croak "No victim here!";
my $victim = $arg->clone();
my $size = length($victim->{'_str'});
croak "Too many changes" if $self->{'_howMany'} >= $size;
my @char_array = 0..($size-1); # Avoids double mutation in a single place
for ( my $i = 0; $i < $self->{'_howMany'}; $i++ ) {
my $rnd = int (rand( @char_array ));
my $who = splice(@char_array, $rnd, 1 );
my $what = $victim->Atom( $who );
my @these_chars = @{ $victim->{'_chars'}};
for ( my $c = 0; $c < @{ $victim->{'_chars'}}; $c++ ) { #Exclude this character
if ( $victim->{'_chars'}[$c] eq $what ) {
lib/Algorithm/Evolutionary/Op/Uniform_Crossover.pm view on Meta::CPAN
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() )?
$victim2->size():$victim->size();
for ( my $i = 0; $i < $min_length; $i++ ) {
if ( rand() < $self->{'_crossover_rate'}) {
$victim->Atom($i, $victim2->Atom($i));
}
}
$victim->{'_fitness'} = undef;
return $victim;
}
=head1 Copyright
lib/Algorithm/Evolutionary/Op/Uniform_Crossover_Diff.pm view on Meta::CPAN
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!";
my $victim2 = $arg2->clone();
my $victim = $arg->clone();
my $min_length = ( length( $victim->{_str} ) > length( $victim2->{_str} ) )?
length( $victim2->{_str} ): length( $victim->{_str} );
my @diffs;
for ( my $i = 0; $i < $min_length; $i ++ ) {
if ( substr( $victim2->{_str}, $i, 1 ) ne substr( $victim->{_str}, $i, 1 ) ) {
push @diffs, $i;
}
}
for ( my $i = 0; $i < $self->{'_numPoints'}; $i ++ ) {
if ( $#diffs > 0 ) {
my $diff = splice( @diffs, rand(@diffs), 1 );
substr( $victim->{'_str'}, $diff, 1 ) = substr( $victim2->{'_str'}, $diff, 1 );
} else {
lib/Algorithm/Evolutionary/Op/VectorCrossover.pm view on Meta::CPAN
} else {
my $pt1 = int( rand( @{$victim->{'_array'}} - 1 ) ) ; #in int env; contains $# +1
my $possibleRange = @{$victim->{'_array'}} - $pt1 - 1;
my $range;
if ( $self->{'_numPoints'} > 1 ) {
$range = 1+ int ( rand( $possibleRange ) );
} else {
$range = $possibleRange + 1;
}
#Check length to avoid unwanted lengthening
return $victim if ( ( $pt1+$range >= @{$victim->{'_array'}} ) || ( $pt1+$range >= @{$victim2->{'_array'}} ));
@{$victim->{'_array'}}[$pt1..($pt1+$range)] =
@{$victim2->{'_array'}}[$pt1..($pt1+$range)];
$victim->Fitness( undef ); #It's been changed, so fitness is invalid
}
return $victim;
}
=head1 Copyright
( run in 0.824 second using v1.01-cache-2.11-cpan-65fba6d93b7 )