#!/usr/bin/perl -w
use strict;
use Algorithm::Genetic;

my $target = "just another perl hacker";
my @alphabet = ( 'a'..'z',' ' );

my $algo = new Algorithm::Genetic( {
    FITNESS => \&fitness,
    MUTATOR => \&mutate,
    BREEDER => \&breed,
    MUTATE_CRITERIA => sub { $_[ 0 ]->{ FITNESS } + 1 },
    MUTATE_FRACTION => .1,
    BREED_CRITERIA => sub{ $_[ 0 ]->{ FITNESS } + 1 },
    BREED_FRACTION => 1
} );

my @initcode;
foreach ( 0..500 ) { 
    my $string = join '', map {  $alphabet[ int rand @alphabet ] } 
    ( 1..length $target );
    $initcode[ $_ ] = $string;
};


$algo->init_population( @initcode );
my $test_string = "";
while ( $test_string ne $target ) {
    print "\n";
    $algo->process_generation();
    $test_string = ($algo->get_population())[0];
    print "$test_string";
}
print " for ",$algo->get_generation_number()." generations and counting!\n";

sub mutate {
    my $clone = $_[0]->{ DATA };
    if ( int rand 2 ) {
        substr( $clone, int rand length $clone, 1, 
        $alphabet[ int rand @alphabet ] );
    } else {
        my @chars = split //, $clone;
        my $pos1 = int rand @chars;
        my $pos2 = $pos1;
        $pos2 = int rand @chars while ( $pos2 == $pos1 );
        ( $chars[$pos1], $chars[$pos2] ) = ( $chars[$pos1], $chars[$pos2] );
        $clone = join '', @chars;
    }
    return $clone;
}

sub breed {
    my $child1 = $_[0]->{ PARENT1 };
    my $child2 = $_[0]->{ PARENT2 };
    if ( rand(1.0) < 0.8 ) {
        my $pos = int rand ( length $target );
        my $length = length ( $target ) - $pos;
        my $t = substr( $child1, $pos, $length );
        $t = substr( $child2, $pos, $length, $t );
        substr( $child1, $pos, $length, $t );
        
    }
    return ( $child1, $child2 );
}


sub fitness {
    my $string = $_[0]->{ DATA };
    return calculate_fitness( $string )**2;
}

sub calculate_fitness{
    my $string = shift;
    my $score = 0;
    my @tarex = split //, $target;
    my @data = split //, $string;
    my @correct;
    for my $i ( 0..@tarex-1 )
    {
        if ($tarex[ $i ] eq $data[ $i ]) {
            $score += 30;
            push @correct, $i;
        }
    }
    return $score;

}