view release on metacpan or  search on metacpan

scripts/canonical-genetic-algorithm.pl  view on Meta::CPAN

Output shows the number of generations, the winning chromosome, and
fitness. After finishing, it outputs time, cache ratio and some other
things. 

=cut

use warnings;
use strict;

use Time::HiRes qw( gettimeofday tv_interval); #for benchmarking

use lib qw(lib ../lib);
#Importing all neded modules using the short POE-ish version
use Algorithm::Evolutionary qw( Individual::BitString Op::Creator 
				Op::CanonicalGA Op::Bitflip 
				Op::Crossover Fitness::Royal_Road);
use Algorithm::Evolutionary::Utils qw(entropy consensus);

#----------------------------------------------------------#
my $bits = shift || 64;
my $block_size = shift || 4;
my $pop_size = shift || 256; #Population size
my $numGens = shift || 200; #Max number of generations
my $selection_rate = shift || 0.2;


#----------------------------------------------------------#
#Initial population
my @pop;
my $creator = new Algorithm::Evolutionary::Op::Creator( $pop_size, 'BitString', { length => $bits });
$creator->apply( \@pop ); #Generates population

#----------------------------------------------------------#
# Variation operators
my $m = Algorithm::Evolutionary::Op::Bitflip->new( 1 );
my $c = Algorithm::Evolutionary::Op::Crossover->new(2, 4);

# Fitness function: create it and evaluate
my $rr = new  Algorithm::Evolutionary::Fitness::Royal_Road( $block_size );
map( $_->evaluate( $rr ), @pop ); 

#----------------------------------------------------------#
#Usamos estos operadores para definir una generación del algoritmo. Lo cual
# no es realmente necesario ya que este algoritmo define ambos operadores por
# defecto. Los parámetros son la función de fitness, la tasa de selección y los
# operadores de variación.
my $generation = Algorithm::Evolutionary::Op::CanonicalGA->new( $rr , $selection_rate , [$m, $c] ) ;

#Time, counter and do the do
my $inicioTiempo = [gettimeofday()];
my $contador=0;
do {
  $generation->apply( \@pop );
  print "$contador : ", $pop[0]->asString(), "\n" ;
  $contador++;
} while( ($contador < $numGens) 
	 && ($pop[0]->Fitness() < $bits));


#----------------------------------------------------------#
# Show best
print "Best is:\n\t ",$pop[0]->asString()," Fitness: ",$pop[0]->Fitness(),"\n";

print "\n\n\tTime: ", tv_interval( $inicioTiempo ) , "\n";

print "\n\tEvaluations: ", $rr->evaluations(), "\n";

print "\n\tCache size ratio: ", $rr->cached_evals()/$rr->evaluations(), "\n";

=head1 SEE ALSO


First, you should obviously check
    L<Algorithm::Evolutionary::Op::CanonicalGA>, and then these other classes.

=over 4

=item *

L<Algorithm::Evolutionary::Op::Base>.

=item *

L<Algorithm::Evolutionary::Individual::Base>.

=item *

L<Algorithm::Evolutionary::Fitness::Base>.

=item *

L<Algorithm::Evolutionary::Experiment>.

=item *

L<XML>

=back

=head1 AUTHOR

J. J. Merelo, C<jj (at) merelo.net>

=cut

=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

  CVS Info: $Date: 2009/07/30 07:48:48 $ 
  $Header: /media/Backup/Repos/opeal/opeal/Algorithm-Evolutionary/scripts/canonical-genetic-algorithm.pl,v 3.1 2009/07/30 07:48:48 jmerelo Exp $ 
  $Author: jmerelo $ 
  $Revision: 3.1 $


=cut