You might be wondering why I posted something as simple as Game::Life recently. Well, partially, it was to head towards this example of using a Genetic Algorithm (via Algorithm::Genetic).

What this does is creates several small Life structures, and uses those to breed new Life structures. The fitness is based on the idea of moving the structure along a distance (direction unspecified), without 'dropping' a lot of stuff or gaining too much. So two aspects are used: the distance that the center of mass moves, and how much the mass changes compared to how it starts. This is calculated after a fixed number of Life generations.

The breeding is done by taking a randomly determined area from the two parents and swapping it. Mutations flip a random bit.

Note that this is a SLOW program. The order scales with $boardsize^2 * $lifetime * $popsize * $generations, and to be effective, $lifetime needs to be sufficient large to allow 'movement' of the Life forms. I ran a much smaller version of this to make sure things were converging, but didn't try anything of a large order (though once a new system I have has sufficient cooling, I'll try it then).

Update few fixes up above.

#!/usr/bin/perl

use Game::Life;
use Algorithm::Genetic;
use Clone qw( clone );

my $lifesize = 10;      # How big of initial Lifes to look at
my $boardsize = 25;     # How big of a Life board to play on
my $lifetime = 50;      # How many Life generations to look through
my $popsize = 100;      # How many initial Life organizes to start wit
+h
my $generations = 100;  # How many GA generations to run through

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

my @pop;
for (1..$popsize) {
    my $life = [ map { [ map { int rand 2 } (1..$lifesize) ] }
               (1..$lifesize) ] ;
    push @pop, $life;
}

$algo->init_population( @pop );
for ( 1..$generations ) {
    $algo->process_generation();
    my $life = ($algo->get_population())[0];
    foreach ( @$life ) {
        print map { $_ ? 'X' : '.' } @$_;
        print "\n";
    }
    print "\n\n";
}

sub fitness {
    print "doing fitness\n";
    my $life = $_[0]->{ DATA };
    my $game = new Game::Life( $boardsize );
    $game->place_points( ($boardsize-$lifesize)/2,                
                         ($boardsize-$lifesize)/2, $life );
    my $before_com = calculate_com( $game->get_grid() );
    $game->process( $lifetime );
    my $after_com = calculate_com( $game->get_grid() );
    my $value;
    # if it died out, it sucks!
    if ( $after_com->[0] == 0 ) { 
        $value = 0;
    } else {
        $value = sqrt( ( $before_com->[1]-$after_com->[1] )**2 + 
                  ( $before_com->[2]-$after_com->[2] )**2 );
        my $weight = ( $after_com->[0] * 
                       ( 2*$before_com->[0] - $after_com->[0] ) )/
                     $before_com->[0]**2;
        $value = ( $weight > 0 ) ? $weight * $value : 0;
    }
    print $value, "\n";
    return $value;
}

sub breed {
    print "doing breeding\n";
    # Breed by take a section of the grid and moving between.
    my $life1 = clone( $_[0]->{ PARENT1 } );
    my $life2 = clone( $_[0]->{ PARENT2 } );

    if ( rand(1.0) < 0.8 ) {
        my $pointx = int rand $lifesize;
        my $pointy = int rand $lifesize;
        my $quad = int rand 4;
        my @xrange;
        my @yrange;
        if ( $quad < 2 ) {
            @xrange = ( 0..$pointx );
        } else {
            @xrange = ( $pointx..$lifesize-1 );
        }
        if ( $quad % 2 ) {
            @yrange = ( 0..$pointy );
        } else {
            @yrange = ( $pointy..$lifesize-1 );
        }
        my $test =0;
        for my $i ( @xrange ) {
            for my $j ( @yrange ) {
                $test++;
                my $t = $life1->[$i]->[$j];
                $life1->[$i]->[$j] = $life2->[$i]->[$j];
                $life2->[$i]->[$j] = $t;
            }
        }
    }
    return ( $life1, $life2 );
}

sub mutate {
    print "doing mutate\n";

    my $life = clone( $_[0]->{ DATA } );
    my $x = int rand @lifesize;
    my $y = int rand @lifesize;
    $life->[$x]->[$y] = !($life->[$x]->[$y]);
    return $life;
}

sub calculate_com {
    my $life = shift;
    my $xsum = 0;
    my $ysum = 0;
    my $total = 0;
    for my $i ( 0..@$life - 1 ) {
        for my $j ( 0..@{$life->[0]} - 1 ) {
            if ( $life->[$i]->[$j] ) {
                $xsum += $i;
                $ysum += $j;
                $total++;
            }
        }
    }
    if ( !$total ) { 
        return [ 0, -1, -1 ]; 
    } else {
        return [ $total, $xsum / $total , $ysum / $total ];
    }
}
[download]

---

Dr. Michael K. Neylon - mneylon-pm@masemware.com || "You've left the lens cap of your mind on again, Pinky" - The Brain