# calculate the fitness of the DNA
sub fitness
{
       my $dna = shift @_;
       my @words = split ' ', dna_to_words($dna);
       my $fitness = 0; # start with 0 fitness
       my $max_entry_length = 20; # longest word we accept

       # note that the 'words' here are command words or numbers

       foreach my $word (@words) # execute all the words as "instructions"
       {
             if ($word eq 'M') # 'multiply' instruction
             {
                   $fitness *= 2;
             }
             elsif ($word =~ /^A\D*(\d+)/) # 'amplify' instruction
             {
                   $fitness *= $1
             }
             elsif ($word =~ /(\d+)/) # if the instruction is a number
             {
                   $fitness += length($1); # increase the fitness depending on the run of digits
             }
             else
             {
                   $fitness *= 0.80; # the punishment for a 'bad' instruction
             }
       }

       return $fitness;
} # end of fitness()

# calculate the fitness of the DNA
sub fitness
{
       my $dna = shift @_;
       my @words = split ' ', dna_to_words($dna);
       my $fitness = 2; # start with a small fitness
       my $location = Math::Complex->make(0,0); # starting coordinates
       # "ideal" coordinates
       my $goal = Math::Complex->make(10,10);
       # the path to the goal the DNA instructions must follow
       my @path = split ' ', 'U U U R R R U U U R R R U U U R R R U R';
       my $path_followed = 1;

       # keep track of motion stack (array)
       my @motion_stack;

       # set up motion instructions
       my $instructions = {
             U => Math::Complex->make( 0, 1),
             D => Math::Complex->make( 0,-1),
             L => Math::Complex->make(-1, 0),
             R => Math::Complex->make( 1, 0),
             B => # move back
             sub {
                   my $location = shift @_;
                   my $motion_stack = shift @_;
                   my $instructions = shift @_;
                   my $old_motion = pop @$motion_stack;
             $location += $instructions->{$old_motion} if defined $old_motion;
                   return $location;
             },
       };

       # note that the 'words' here are command words or numbers

       foreach my $word (@words) # execute all the words as "instructions"
       {
             # only handle legitimate instructions (they can be embedded in bigger words)
             my ($motion, $mag) = $word =~ m/([A-Z])(\d*)/;
       if ($motion && exists $instructions->{$motion})
             {
                   $mag = 1 unless $mag; # always run at least once
             my $instruction = $instructions->{$motion};
                   foreach (1..$mag)
                   {
                         if (ref $instruction eq 'Math::Complex')
                         {
                               $location += $instruction; # use the motion vector
                               push @motion_stack, $motion;
                         }
                         elsif (ref $instruction eq 'CODE')
                         {
                               $location = $instruction->($location, \@motion_stack, $instructions);
                               # use the subroutine
                         }
                   }
             }
       }
       # now see if the individual followed the necessary path
       # (if he didn't, he "fell off the cliff")
       foreach my $path_instruction (@path)
       {
             my $instruction = shift @motion_stack;
             # get the actually executed instruction
             if (defined $instruction && $instruction eq $path_instruction)
             {
                   # increase fitness, this individual followed the proper path
                   $fitness *= 2;
                   $path_followed = 1; # the individual has not strayed
             }
             else
             {
                   # increase fitness a little, so the individual is rewarded for
                   # having followed the path this far
                   $fitness++;
                   $path_followed = 0; # the individual has strayed, though
                   last;
             }
       }
       if ($location == $goal && $path_followed)
       {
             # no point continuing, the individual found the target
       die "Individual [@words] reached the target!"; }

       return $fitness;
} # end of fitness()

# this is a closure block!
{
       # private static variable @dictionary in closure for fitness() only
       my @dictionary;
       # calculate the fitness of the DNA
       sub fitness
       {
             my $dna = shift @_;
             my @words = split ' ', dna_to_words($dna);
             my $fitness = 0; # start with 0 fitness
             my $max_entry_length = 20; # longest word we accept
             my $precision = 90; # matching precision, in percent
             my $imprecision = 100 - 90;
             die "Can't use a negative imprecision (your precision must
             be less than 100 but it's $precision)"
             if $imprecision < 0;
             # you can use any word list at the end of the program
             # do the @dictionary initialization just once
             unless (@dictionary)
             {
                   @dictionary = <DATA>;
                   foreach (@dictionary)
                   {
                         chomp;
                   }
                   # eliminate words over $max_entry_length letters, and uppercase them
             @dictionary = grep { length($_) > 1 && length($_) < $max_entry_length }
             map { uc } @dictionary;
             }
             # there is no easy way to avoid this exhaustive check of the dictionary
             # without complicating this example too much
             foreach my $word (@words)
             {
                   next unless length $ word > 1; # don't use single letters
                   # note we use "S#%", we don't want insert/append similarities,
                   # only replacement similarities
                   my @matches = amatch($word, "$imprecision%", @dictionary);
             my @precise_matches = grep { $word eq $_ } @dictionary;
                   $fitness += scalar @matches;
                   $fitness += (10 ** length $_) foreach @precise_matches;
                   # reward longer words significantly more
             }
             return $fitness;
       } # end of fitness()
}