#!perl

use strict;
use warnings;

=head1 NAME

  1stga.pl - First approximation at an evolutionary algorithm in Perl

=head1 SYNOPSIS

  prompt$ perl 1stga.pl <number of generations>

=head1 DESCRIPTION

This is an evolutionary algorithm that uses mutation to make a set of strings  evolve so that they approximate "yetanother". The strings are lowercase letters, plus _, which is conventionally situated at the end of the alphabet. 

Each generation, a string is picked up, mutated, and, if the result is better than the original one, replaces the worst one.

Overall, distance to the aforementioned string should be minimized

=cut 

#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 );
my @alphabet = ('a'..'z');
my @population;

#Declare some subs (not the best place to do it, but we are going to
#need them
sub fitness ($;$) {
  my $string = shift;
  my $distance = 0;
  for ( 0..($strLength -1)) {
    $distance += abs( ord( substr( $string, $_, 1)) -   ord( substr( $targetString, $_, 1)));
  }
  return $distance;
}

sub printPopulation {
  for (@population) {
    print "$_->{_str} -> $_->{_fitness} \n";
  }
}

sub mutate {
  my $chromosome = shift;
  my $mutationPoint = rand( length( $chromosome->{_str}));
  substr(  $chromosome->{_str}, $mutationPoint, 1 ) = $alphabet[( rand( @alphabet))]; 
}

#Init population
for ( 1..$popSize ) {
  my $chromosome = { _str => '',
		     _fitness => 0 };
  for ( 1..$strLength ) {
    $chromosome->{_str} .= $alphabet[( rand( @alphabet))]; 
  }
  $chromosome->{_fitness} = fitness( $chromosome->{_str} );
  push @population, $chromosome;
}

#Print initial population
printPopulation();

#Sort population
@population = sort { $a->{_fitness} <=> $b->{_fitness} } @population;

#Go ahead with the algorithm
for ( 1..$generations ) {
  my $chromosome = $population[ rand( @population)];
  #Generate offspring that is better
  my $clone ={};
  do {
    $clone = { _str => $chromosome->{_str},
		  _fitness => 0 };
    mutate( $clone );
    $clone->{_fitness} = fitness( $clone->{_str} );
  } until ( $clone->{_fitness} >  $chromosome->{_fitness});
  
  #Substitute worst
  $population[$#population]=$clone;

  #Re-sort
  @population = sort { $a->{_fitness} <=> $b->{_fitness} } @population;

  #Print best
  print "Best so far: $population[0]->{_str} => $population[0]->{_fitness} \n";

  #Early exit
  last if $population[0]->{_fitness} == 0;
}
  
