#!perl

use strict;
use warnings;

=head1 NAME

  canonical-classical-ga.pl - A canonical genetic algorithm acting on bitstrings written in Perl

=head1 SYNOPSIS

  prompt$ perl canonical-classical.pl <number of bits>

=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.

Optimized function is going to be the also classical "onemax"
function, in which the optimal string is a string composed by all ones.

=cut 

use Algorithm::Evolutionary::Wheel;
require "LittleEA.pm";

#Declare variables

my $numberOfBits = shift || 32; 
my $popSize = 200; # No need to keep it variable
my @population;

#Declare some subs (not the best place to do it, but we are going to
#need them
sub fitness ($;$) {
  my $indi=shift;
  my $total = grep( $_ == 1, split(//,$indi ));
  return $total;
}

#Binary version of the mutation operator
sub mutateBinary {
  my $chromosome = shift;
  my $mutationPoint = rand( length( $chromosome->{_str}));
  my $bit = substr(  $chromosome->{_str}, $mutationPoint, 1 );
  substr(  $chromosome->{_str}, $mutationPoint, 1, $bit?1:0 ); 
}

#Init population
for ( 1..$popSize ) {
  my $chromosome = { _str => '',
		     _fitness => 0 };
  for ( 1..$numberOfBits ) {
    $chromosome->{_str} .= rand() > 0.5?1:0; 
  }
  $chromosome->{_fitness} = fitness( $chromosome->{_str} );
  push @population, $chromosome;
}

#Print initial population
printPopulation( \@population );

#Sort population
@population = sort { $b->{_fitness} <=> $a->{_fitness} } @population;

#Go ahead with the algorithm
do {
  my @newPop;
  my @rates;
  for ( @population ) {
    push @rates, $_->{_fitness};
  }
  my $popWheel=new Algorithm::Evolutionary::Wheel @rates;

  for ( my $i = 0; $i < $popSize/2; $i ++ ) {
    my $chr1 = $population[$popWheel->spin()];
    my $chr2 = $population[$popWheel->spin()];
    #Generate offspring that is better
    my  $clone1 = { _str => $chr1->{_str},
		    _fitness => 0 };
    my  $clone2 = { _str => $chr2->{_str},
		    _fitness => 0 };
    mutateBinary( $clone1 );
    mutateBinary( $clone2 );
    crossover( $clone1, $clone2 );
    $clone1->{_fitness} = fitness( $clone1->{_str} );
    $clone2->{_fitness} = fitness( $clone2->{_str} );
    push @newPop, $clone1, $clone2;
    
  }
  #Re-sort
  @population = sort { $b->{_fitness} <=> $a->{_fitness} } @newPop;
  #Print best
  print "Best so far: $population[0]->{_str}\n";

} until ( $population[0]->{_fitness} == $numberOfBits );
print "We're done\n";
printPopulation( \@population );


  
