Algorithm-Evolutionary-Simple

 view release on metacpan or  search on metacpan

lib/Algorithm/Evolutionary/Simple.pm  view on Meta::CPAN

use base 'Exporter';
use Sort::Key::Top qw(rnkeytop) ;

our @EXPORT_OK= qw( random_chromosome max_ones max_ones_fast spin 
		  get_pool_roulette_wheel get_pool_binary_tournament
		  produce_offspring mutate crossover single_generation );

# Module implementation here
sub random_chromosome {
  my $length = shift;
  my $string = '';
  for (1..$length) {
    $string .= (rand >0.5)?1:0;
  }
  $string;
}

sub max_ones {
  my $str=shift;
  my $count = 0;
  while ($str) {
    $count += chop($str);

lib/Algorithm/Evolutionary/Simple.pm  view on Meta::CPAN

    my $first = $pool->[rand($population_size)];
    my $second = $pool->[rand($population_size)];
    push @population, crossover( $first, $second );
  }
  map( $_ = mutate($_), @population );
  return @population;
}

sub mutate {
  my $chromosome = shift;
  my $mutation_point = int(rand( length( $chromosome )));
  substr($chromosome, $mutation_point, 1,
	 ( substr($chromosome, $mutation_point, 1) eq 1 )?0:1 );
  return $chromosome;
}

sub crossover {
  my ($chromosome_1, $chromosome_2) = @_;
  my $length = length( $chromosome_1 );
  my $xover_point_1 = int rand( $length - 2 );
  my $range = 1 + int rand ( $length - $xover_point_1 );
  my $swap_chrom = $chromosome_1;
  substr($chromosome_1, $xover_point_1, $range,
	 substr($chromosome_2, $xover_point_1, $range) );
  substr($chromosome_2, $xover_point_1, $range,
	 substr($swap_chrom, $xover_point_1, $range) );
  return ( $chromosome_1, $chromosome_2 );
}

sub single_generation {
  my $population = shift || croak "No population";

lib/Algorithm/Evolutionary/Simple.pm  view on Meta::CPAN

=head1 SYNOPSIS

  use Algorithm::Evolutionary::Simple qw( random_chromosome max_ones max_ones_fast
					get_pool_roulette_wheel get_pool_binary_tournament produce_offspring single_generation);

  my @population;
  my %fitness_of;
  for (my $i = 0; $i < $number_of_strings; $i++) {
   $population[$i] = random_chromosome( $length);
   $fitness_of{$population[$i]} = max_ones( $population[$i] );
  }

  my @best;
  my $generations=0;
  do {
    my @pool;
    if ( $generations % 2 == 1 ) {
      get_pool_roulette_wheel( \@population, \%fitness_of, $number_of_strings );
    } else {

lib/Algorithm/Evolutionary/Simple.pm  view on Meta::CPAN

    }
    my @new_pop = produce_offspring( \@pool, $number_of_strings/2 );
    for my $p ( @new_pop ) {
        if ( !$fitness_of{$p} ) {
	   $fitness_of{$p} = max_ones( $p );
	}
    }
    @best = rnkeytop { $fitness_of{$_} } $number_of_strings/2 => @population;
    @population = (@best, @new_pop);
    print "Best so far $best[0] with fitness $fitness_of{$best[0]}\n";
  } while ( ( $generations++ < $number_of_generations ) and ($fitness_of{$best[0]} != $length ));


=head1 DESCRIPTION

Assorted functions needed by an evolutionary algorithm, mainly for demos and simple clients.


=head1 INTERFACE 

=head2 random_chromosome( $length )

Creates a binary chromosome, with uniform distribution of 0s and 1s,
and returns it as a string.

=head2 max_ones( $string )

Classical function that returns the number of ones in a binary string.


=head2 max_ones_fast( $string )

script/bitflip.pl  view on Meta::CPAN

use strict;
use warnings;

use lib qw( ../lib lib );

use version; our $VERSION = qv('0.0.3');
use Algorithm::Evolutionary::Simple qw( random_chromosome mutate);
use Time::HiRes qw( gettimeofday tv_interval );
use v5.14;

my $length = 16;
my $iterations = 100000;
my $top_length = 2**15;
do {
    my $indi = random_chromosome($length);
    say "perlsimple-BitString, $length, ".time_mutations( $iterations, $indi );
    $length *= 2;
} while $length <= $top_length;

#--------------------------------------------------------------------
sub time_mutations {
    my $number = shift;
    my $indi = shift;
    my $inicioTiempo = [gettimeofday()];
    for (1..$number) {
      $indi = mutate( $indi );
    }
    return tv_interval( $inicioTiempo ) 

script/maxones.pl  view on Meta::CPAN

use strict;
use warnings;

use lib qw( ../lib lib );

use version; our $VERSION = qv('0.0.3');
use Algorithm::Evolutionary::Simple qw( random_chromosome max_ones_fast
					single_generation);
use Sort::Key::Top qw(rnkeytop);

my $length = shift || 64;
my $number_of_strings = shift || 64;

my @population;
my %fitness_of;
my $total_fitness;
for (my $i = 0; $i < $number_of_strings; $i++) {
    $population[$i] = random_chromosome( $length);
    $fitness_of{$population[$i]} = max_ones_fast( $population[$i] );
    $total_fitness += $fitness_of{$population[$i]};
}
 
my $evaluations=$#population+1;

do {
  @population = single_generation( \@population, \%fitness_of, $total_fitness );
  $total_fitness = 0;
  for my $p ( @population ) {
	if ( !$fitness_of{$p} ) {
	  $fitness_of{$p} = max_ones_fast( $p );
	}
	$total_fitness += $fitness_of{$p};
  }
  $evaluations += $#population -1; # Two are kept from previous generation
  print "Best so far $population[0] with fitness $fitness_of{$population[0]} and evaluated $evaluations\n";	 
} while ($fitness_of{$population[0]} != $length );



__END__

=head1 NAME

simple-EA.pl - A simple evolutionary algorithm that uses the functions in the library

=head1 VERSION

script/onemax-benchmark.pl  view on Meta::CPAN

use strict;
use warnings;

use lib qw( ../lib lib );

use version; our $VERSION = qv('0.0.3');
use Algorithm::Evolutionary::Simple qw( random_chromosome max_ones_fast);
use Time::HiRes qw( gettimeofday tv_interval );
use v5.14;

my $length = 16;
my $iterations = 100000;
my $top_length = 2**15;
do {
    say "perlsimple-BitString, $length, ".time_onemax( $iterations );
    $length *= 2;
} while $length <= $top_length;

#--------------------------------------------------------------------
sub time_onemax {
    my $number = shift;
    my $inicioTiempo = [gettimeofday()];
    for (1..$number) {
	my $indi = random_chromosome($length);
	my $fitness = max_ones_fast( $indi );
    }
    return tv_interval( $inicioTiempo ) 
}

__END__

=head1 NAME

xover.pl - A simple evolutionary algorithm that uses the functions in the library

script/simple-EA.pl  view on Meta::CPAN

use strict;
use warnings;

use lib qw( ../lib lib );

use version; our $VERSION = qv('0.0.3');
use Algorithm::Evolutionary::Simple qw( random_chromosome max_ones 
					get_pool_roulette_wheel get_pool_binary_tournament produce_offspring  );  
use Sort::Key::Top qw(rnkeytop);

my $length = shift || 64;
my $number_of_strings = shift || 64;
my $number_of_generations = shift || 100;
my $pool = shift || "roulette";


my @population;
my %fitness_of;
for (my $i = 0; $i < $number_of_strings; $i++) {
  $population[$i] = random_chromosome( $length);
  $fitness_of{$population[$i]} = max_ones( $population[$i] );
}

my $get_pool;
if ( $pool eq "roulette" ) {
  $get_pool = \&get_pool_roulette_wheel;
}   else {
  $get_pool = \&get_pool_binary_tournament;
}
my @best;

script/simple-EA.pl  view on Meta::CPAN

    my @pool = $get_pool->( \@population, \%fitness_of, $number_of_strings );
    my @new_pop = produce_offspring( \@pool, $number_of_strings/2 );
    for my $p ( @new_pop ) {
	if ( !$fitness_of{$p} ) {
	    $fitness_of{$p} = max_ones( $p );
	}
    }
    @best = rnkeytop { $fitness_of{$_} } $number_of_strings/2 => @population;
    @population = (@best, @new_pop);
    print "Best so far $best[0] with fitness $fitness_of{$best[0]}\n";	 
} while ( ( $generations++ < $number_of_generations ) and ($fitness_of{$best[0]} != $length ));



__END__

=head1 NAME

simple-EA.pl - A simple evolutionary algorithm that uses the functions in the library

script/xover.pl  view on Meta::CPAN

use strict;
use warnings;

use lib qw( ../lib lib );

use version; our $VERSION = qv('0.0.3');
use Algorithm::Evolutionary::Simple qw( random_chromosome crossover);
use Time::HiRes qw( gettimeofday tv_interval );
use v5.14;

my $length = 16;
my $iterations = 100000;
my $top_length = 2**15;
do {
    say "perlsimple-BitString, $length, ".time_crossover( $iterations );
    $length *= 2;
} while $length <= $top_length;

#--------------------------------------------------------------------
sub time_crossover {
    my $number = shift;
    my $inicioTiempo = [gettimeofday()];
    my $indi = random_chromosome($length);
    my $another_indi = random_chromosome($length);
    for (1..$number) {
      ($indi,$another_indi) = crossover( $indi,$another_indi );
    }
    return tv_interval( $inicioTiempo ) 
}

__END__

=head1 NAME

t/01.functions.t  view on Meta::CPAN

use warnings;

use lib qw( ../lib lib );

use Sort::Key::Top qw(rnkeytop) ;
use Algorithm::Evolutionary::Simple
  qw( random_chromosome max_ones 
      get_pool_roulette_wheel get_pool_binary_tournament
      produce_offspring single_generation);

my $length = 32;
my $number_of_strings = 32;

my @population;
my %fitness_of;
my $total_fitness;
for (my $i = 0; $i < $number_of_strings; $i++) {
  $population[$i] = random_chromosome( $length);
  is( length($population[$i]), $length, "Ok length");
   if ( $i > 1 ){
    isnt( $population[$i], $population[$i-1], "Ok random");
  }
  $fitness_of{$population[$i]} = max_ones( $population[$i] );
  $total_fitness += $fitness_of{$population[$i]};
  my $count_ones = grep( $_ eq 1, split(//, $population[$i]));
  is( $fitness_of{$population[$i]}, $count_ones, "Counting ones" );
}

throws_ok { get_pool_roulette_wheel() } qr/No/, "Population check";