#!perl

use strict;
use warnings;

=head1 NAME

  cga-ai-gene.pl - Canonical GA using AI::Gene::Simple

=head1 SYNOPSIS

  prompt$ perl cga-ai-gene.pl <number of bits>

=head1 DESCRIPTION

Canonical GA, as described in his book "GAs in search, optimization
and machine learning". This algorithm uses fitness-proportionate
selection for the chromosomes that will be reproduced: each chromosome
will have a number of copies in the genetic pool that is proportional
to its fitness.

=cut

use AI::Gene::AI::Gene::Simple;

package MyGene;

our @ISA = qw (AI::Gene::Simple);

sub render_gene {
  my $self = shift;
  return join '', @{$self->[0]};
}

sub mutate_minor {
  my $self = shift;
  my $num = +$_[0] || 1;
  my $rt = 0;
  for (1..$num) {
    my $glen = scalar @{$self->[0]};
    my $pos = defined $_[1] ? $_[1] : int rand $glen;
    next if $pos >= $glen;  # pos lies outside of gene
    my $token = $self->generate_token();
    $self->[0][$pos] = $token;
    $rt++;
  }
  return $rt;
}

package main;

use Algorithm::Evolutionary::Wheel;

#Declare variables
my $generations = shift || 500; #Which might be enough
my $popSize = 100; # No need to keep it variable
my $targetString = 'yetanother';
my $strLength = length( $targetString );

sub fitness ($;$) {
  my $ary = shift;
  my $distance = 0;
  for ( 0..($strLength -1)) {
    $distance += abs( ord(  $ary->[$_]) -  ord( substr( $targetString, $_, 1)));
  }
  return $distance;
}

sub printPopulation {
  my $pop = shift;
  for (@$pop) {
    print $_->render_gene(), " -> $_->[1] \n";
  }
}

#Does crossover; interchanges chunks of both chromosomes
sub crossover {
  my ($chr1, $chr2) = @_;
  my $length =  scalar( @{$chr1->[0]});
  my $crossoverPoint = int (rand( $length));
  my $range = int( rand( $length - $crossoverPoint ));
  my @tmpAry = @{$chr1->[0]};
  @{$chr1->[0]}[ $crossoverPoint..($crossoverPoint+ $range)] = 
      @{$chr2->[0]}[$crossoverPoint..($crossoverPoint+ $range)];
  @{$chr2->[0]}[ $crossoverPoint..($crossoverPoint+ $range)] =
    @tmpAry[ $crossoverPoint..($crossoverPoint+ $range)];
}

my @population;
for ( 1..$popSize ) {
  my $chromosome = MyGene->new();
  $chromosome->mutate_insert( $strLength );
  $chromosome->[1] = fitness( $chromosome->[0] );
  push @population, $chromosome;
}

printPopulation( \@population);

#Sort population
@population = sort { $a->[1] <=> $b->[1] } @population;

#Go ahead with the algorithm
for ( 1..$generations ) {
  my @newPop;
  my @rates;
  for ( @population ) {
    push @rates, 1/$_->[1];
  }
  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()];
    my $clone1 = $chr1->clone();
    my $clone2 = $chr2->clone();
    $clone1->mutate_minor(1);
    $clone2->mutate_minor(1);
    crossover( $clone1, $clone2 );
    $clone1->[1] = fitness( $clone1->[0] );
    $clone2->[1] = fitness( $clone2->[0] );
    push @newPop, $clone1, $clone2;    
  }
  #Re-sort
  @population = sort { $a->[1] <=> $b->[1] } @newPop;
  #Print best
  print "Best so far: ", $population[0]->render_gene(), "\n";

  printPopulation( \@population );

  #Early exit
  last if $population[0]->[1] == 0;
}
