Re: Improving Evolutionary Algorithm

[blokhead]

I'm glad you liked my EA writeup. This sounds like an interesting problem for EAs, and what you've got looks good. I see you've introduced a cataclysm to reset part of the population. You have it triggered at random, but usually such an event is triggered when fitness is levelling off and becoming very uniform.

You seem to have a fine grasp of things, I don't have any specific code comments, but one thing I can suggest is to use some ready-made EA framework instead of implementing all the nitty-gritty population-munging stuff yourself. (shameless plug) A module I wrote called Algorithm::Evolve does this and works pretty well for simple EA fun like this (though I haven't done much development on it lately). Here's what this problem would look like using an ArrayEvolver base class from the examples/ directory: I did have to make a few modifications to your problem like maximizing the fitness measure, since the framework needs to maximize fitness.

package MyCritters;

my $size;
BEGIN { $size = shift || 10; }

## set up a default critter class using an array representation:

use ArrayEvolver alphabet => [0 .. $size-1],
                 mutation_rate => 1/$size,
                 gene_length => $size;
@ISA = ('ArrayEvolver');

## add a new method:

sub as_sentence {
    my $critter = shift;
    sprintf "This sentence contains " .
            join(", " => map qq[%d "$_"s], 0 .. $size-1),
            @{ $critter->gene };
}

## override the default fitness method:

sub fitness {
    my $critter  = shift;
    my $sentence = $critter->as_sentence;
    my $differences;
    for (0 .. $size-1) {
        my $count = () = $sentence =~ /($_)/g;
        $differences += abs( $count - $critter->gene->[$_] );
    }
    return $size*$size - $differences;
}

#############
package main;
use Algorithm::Evolve;

## this gets called after every generation:

sub callback {
    my $p = shift;

    printf "score = %d/%d after %d generations\n",
            $p->best_fit->fitness, $size*$size, $p->generations
        unless $p->generations % 100;

    $p->suspend if $p->generations >= 1000
                or $p->best_fit->fitness == ($size*$size);
}   

## set up a population object:

my $p = Algorithm::Evolve->new(
    critter_class    => 'MyCritters',
    selection        => 'roulette',
    replacement      => 'random',
    parents_per_gen  => 10,
    size             => 100,
    random_seed      => shift,
    callback         => \&callback
);
$p->start;

printf "%s (score = %d/%d)\n",
       $p->best_fit->as_sentence, $p->best_fit->fitness, $size*$size;

The benefit of this is that when the population-munging stuff is factored out, you can now easily modify the parameters of the EA: number of parents, population size, selection & replacement methods. It makes it easier to find combinations that work.

This also seems to run a lot faster than yours, though I don't know exactly where the slowdown is in your code. You've at least memoized the fitness function, which is a common bottleneck.

As for this specific problem, I don't know as much about it as others who've responded. It might not be stable enough for an EA, or there might be a more direct and efficient way to find solutions -- I wasn't able to reach a solution for N=10 after many attempts. Maybe a huge population and very small fitness bias would help. Or just adding +1/-1 for mutations, instead of just picking a brand new number at a position. Plus, are you even sure that a solution exists for the N=10 case? That would also be worth exploring, before you get discouraged with EAs ;)

Finally, to balance out my shameless plug, I try to keep a list of Perl EA resources in my homenode, so if you don't like Algorithm::Evolve, there are several other choices worth looking into.

[jmerelo]

Which is available from sourceforge

[jmerelo]

Like Algorithm::Evolutionary, with new version (and paper) coming soon.