#!/usr/bin/perl -w

use strict;

use Algorithm::Genetic;
use Data::Dumper;

my @genes = qw{
    $x+=1; $x=$y; $y=$x; $x|=$y; $x+=$y;
};

my $target = 100;

my $algo = new Algorithm::Genetic( {
    FITNESS => \&fitness,
    MUTATOR => \&mutate,
    REAP_CRITERIA => sub { $_[ 0 ]->{ FITNESS } },
    MUTATE_CRITERIA => sub { (10000-$_[ 0 ]->{ FITNESS } )**2 }
} );


my @initcode;
foreach ( 0..10 ) { 
    my @bits = map {  int rand @genes } ( 0..10 );
    $initcode[ $_ ] = \@bits;
};


$algo->init_population( @initcode );

for (1..100) {
    print "GENERATION $_\n";
    print "-------------\n";
    print join "\n", map { eval_code( get_code( @$_ ) ).' : '.get_code
+( @$_ ) } reverse $algo->get_population();
    print "\n";
    $algo->process_generation();
    print "\n";
}


sub mutate {
    my @clone = @{ $_[0]->{ DATA } };

    if ( int( rand() + 0.5 ) ) { 
    # mutate by switching a new op in
    my $pos = int rand @clone;
    my $newop = int rand @genes;
    while ( $newop == $clone[ $pos ] ) {
        $newop = int rand @genes;
    }
    $clone[ $pos ] = $newop;    
    } else {
    # mutate by adding a new op in
    push @clone, $genes[ int rand @genes ];
    }
    return \@clone;
}

sub fitness {
    my $code = $_[0]->{ DATA };
   
    # Calculate the fitness;
    my $string = get_code( @$code );
    my $calc = eval_code( $string );
    return ( $calc - $target )**2;
}

sub get_code { 
    my $string = 'my $x = 1; my $y = 1; ';
    $string = join '', $string, map { $genes[ $_ ] } @_;
    return $string;
}    

sub eval_code {
    return eval( $_[0] );
}
[download]

While probably not as robust as the original entry, the solutions I'm getting are converging to the target value even after 100 generations, so something is working right...