rj@goliath: perl -V
Summary of my perl5 (revision 5.0 version 6 subversion 0) configuration:
  Platform:
    osname=linux, osvers=2.4.3, archname=ia64-linux
    uname='linux d106 2.4.3 #1 smp mon may 14 17:07:47 gmt 2001 ia64 unknown '
    config_args='-ds -e -Dprefix=/usr -Di_db -Di_dbm -Di_ndbm -Di_gdbm -Doptimize=-O0'
    hint=recommended, useposix=true, d_sigaction=define
    usethreads=undef use5005threads=undef useithreads=undef usemultiplicity=undef
    useperlio=undef d_sfio=undef uselargefiles=define 
    use64bitint=define use64bitall=define uselongdouble=undef usesocks=undef
  Compiler:
    cc='cc', optimize='-O0', gccversion=2.96-ia64-000717 snap 001117
    cppflags='-fno-strict-aliasing -I/usr/local/include'
    ccflags ='-fno-strict-aliasing -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64'
    stdchar='char', d_stdstdio=define, usevfork=false
    intsize=4, longsize=8, ptrsize=8, doublesize=8
    d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=16
    ivtype='long', ivsize=8, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8
    alignbytes=8, usemymalloc=n, prototype=define
  Linker and Libraries:
    ld='cc', ldflags =' -L/usr/local/lib'
    libpth=/usr/local/lib /lib /usr/lib
    libs=-lnsl -ldl -lm -lc -lcrypt
    libc=, so=so, useshrplib=false, libperl=libperl.a
  Dynamic Linking:
    dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-rdynamic'
    cccdlflags='-fpic', lddlflags='-shared -L/usr/local/lib'


Characteristics of this binary (from libperl): 
  Compile-time options: USE_64_BIT_INT USE_64_BIT_ALL USE_LARGE_FILES
  Built under linux
  Compiled at May 22 2001 13:16:28
  @INC:
    /usr/lib/perl5/5.6.0/ia64-linux
    /usr/lib/perl5/5.6.0
    /usr/lib/perl5/site_perl/5.6.0/ia64-linux
    /usr/lib/perl5/site_perl/5.6.0
    /usr/lib/perl5/site_perl
    .

##</code><code>##

#!/usr/bin/perl -w

# Based on ideas and code by Brad Murray (bjm@a2b01118.paralynx.bconnected.net), 
# posted to perl-ai list June 3 1999.  Completed and maintained by Ken
# Williams (ken@forum.swarthmore.edu).

# VERSION: $Revision: 1.4 $

use strict;


my @functions = (
                 # Format is 'function <pretty version>: <actual code>'
                 'function add($a,$b): ($a+$b)',
                 'function mul($a,$b): ($a*$b)',
                 'function sin($a,$b): sin($a)',
                 'function log($a,$b): do{my $_a=$a; $_a ? log(abs($_a)) : 0}',
                );

my @terminals = (
                 sub {'$x'},
                 sub {'$x'},
                 sub { int(rand(20) - 10) },
                 sub { int(rand(20) - 10) },
                );

my $maxdepth = 5;
my $pop = 20;
my $mates = 5;
my $gen = 200;

# Get target data set
my @target = split ',', scalar <DATA>;

# Build a starting population of $pop Organisms
my @world = map {{organism => new Organism}} 1..$pop;

my $count = 0;
while ($count<$gen) {
  print "\nGENERATION ", ++$count, "\n";

  foreach (@world) {
    $_->{fitness} = &fitness($_->{organism},@target);
    $_->{as_string} = $_->{organism}->as_string;
  }

  @world = sort { 
             $a->{fitness} <=> $b->{fitness} 
                            or
    length $a->{as_string} <=> length $b->{as_string} 
  } @world;

  foreach (@world) {
    print "=================== Fitness: $_->{fitness} ===================\n";
    print $_->{as_string}, "\n";
  }

  # Kill off some organisms, mate some others to take their spots.  We
  # mate the top n organisms with random elements from the population.
  for (1..$mates) {
    pop @world;
    my ($org1, $org2) = ($world[$mates-1]{organism}, $world[rand @world]{organism});
    ($org1, $org2) = ($org2, $org1) if int rand 2; # Maybe switch roles
    my $child = $org1->mate($org2);
    unshift @world, {organism => $child};
    print "Created '@{[$child->as_string]}' from '@{[$org1->as_string]}' and '@{[$org2->as_string]}'\n";
  }

  # mutate one organism at random
  my $to_mutate = $world[rand @world]{organism};
  print "Mutated '@{[$to_mutate->as_string]}' into ";
  $to_mutate->mutate;
  print "'@{[$to_mutate->as_string]}'\n";

  # Uncomment if you want to watch each step
  #print "<RETURN> to continue:"; <STDIN>;
}

sub fitness {
  # Determine the fitness of an organism in this crazy world

  my ($org, @target) = @_;
  my $sumdiff = 0;

  foreach (0..$#target) {
    $sumdiff += abs($org->evaluate({'x'=>$_}) - $target[$_]);
  }
  return $sumdiff/@target;
}

#####################################################################
package Organism;
use Storable qw(dclone store);


# Syntax tree is a set of hash entries:
#  $node->{a} = $another_node or undef
#  $node->{b} = $another_node or undef
#  $node->{contents} = $function or 'x' or constant
#
# Example:
#  sin(7 * log($x))
# 
#  sin(multiply(7,log($x,0)),0)
#
#                  sin
#                 /   \
#                /     \
#        multiply       0--undef
#        /      \        \
#       7        log      undef
#      / \        / \
# undef  undef   x   0--undef
#               / \   \
#          undef   \   undef
#                 undef
#
# In Perl data structures:
# { contents => 'function sin($a,$b): sin($a)',
#   a        => {
#                contents => 'function mul($a,$b): ($a*$b)',
#                a        => 7,
#                b        => {
#                             contents => 'function log($a,$b): do{my $_a=$a; $_a ? log(abs($_a)) : 0}',
#                             a        => '$x',
#                             b        => 0,
#                            },
#                },
#   b         => 0,
# }


sub new {
  my $package = shift;
  my $self = {tree => $package->_buildTree() };
  return bless $self, $package;
}

sub _buildTree {
  my $self = shift;
  my $depth = shift || 0;
  
  my %tree;

  $tree{contents} = ($depth > $maxdepth or int rand(3)) ?
                     &{$terminals[rand @terminals]} :
                     $functions[rand @functions];

  # 'a' and 'b' are the two arguments to functions
  if ($tree{contents} =~ /^function /) {
    $tree{'a'} = $self->_buildTree($depth + 1);
    $tree{'b'} = $self->_buildTree($depth + 1);
  }

  return \%tree;
}

sub _treeIndex {
  # Generates a list of all the nodes in this tree.  These are
  # references to the stuff in the object itself, so changes to the
  # elements of this list will change the object.

  my $self = shift;
  my $tree = shift || $self->{tree};
  my @sofar = @_;

  # Dump the content nodes into a list
  
  if ($tree->{contents} =~ /^function /) {
    return(@sofar, 
           $tree, 
           $self->_treeIndex($tree->{'a'}, @sofar), 
           $self->_treeIndex($tree->{'b'}, @sofar)
          );
  } else {
    return(@sofar, $tree);
  }
}

sub mate {
  my ($self, $partner) = @_;
  my $self_clone = dclone $self;

  # Get part of a node from $partner and stick it somewhere in $self_clone
  my @clone_index = $self_clone->_treeIndex;
  my @partner_index = $partner->_treeIndex;

  %{ $clone_index[rand @clone_index] } = %{ dclone $partner_index[rand @partner_index] };

  $self_clone->clear_cache;
  return $self_clone;
}

sub mutate {
  my $self = shift;

  my @index = $self->_treeIndex;
  %{ $index[rand @index] } = %{ $self->_buildTree($maxdepth-1) };
  $self->clear_cache;
}

sub evaluate {
  my $self = shift;
  my $params = shift;
  
  my $x = $params->{'x'};
  return eval $self->expression;
}


sub expression {  # Turn the syntax tree into a Perl expression
  my $self = shift;
  my $tree = shift || $self->{tree};

  # Check the cache
  return $self->{expr} if defined $self->{expr};

  local $_ = $tree->{contents}; # A shortcut for the current node

  if ( s/^function [^:]*: (.*)/$1/ ) { # Extract the perl expression
    s/\$([a-zA-Z]+)/$self->expression($tree->{$1})/ge;
  } 

  $self->{expr} = $_ if $tree eq $self->{tree}; # A nasty trick
  return $_;
}

sub as_string {  # Turn the syntax tree into a readable expression
  my $self = shift;
  my $tree = shift || $self->{tree};

  # Check the cache
  return $self->{string} if defined $self->{string};

  local $_ = $tree->{contents}; # A shortcut for the current node

  if ( s/^function ([^:]*):.*/$1/ ) { # Extract the format picture
    s/\$([a-zA-Z]+)/$self->as_string($tree->{$1})/ge;
  }

  $self->{string} = $_ if $tree eq $self->{tree}; # A nasty trick
  return $_;
}

sub clear_cache {
  # Invalidate the cached information.  Typically done after mutation
  # or mating, because the cache represents the old data.
  my $self = shift;
  $self->{expr} = $self->{string} = undef;
}


__END__
-1407,-931,-577,-327,-163,-67,-21,-7,-7,-3,23,89,213,413,707,1113,1649