my $x=1;
my $y=1;
####
$x += 1; $x =$y; $x |=$y; $x +=$y; $y =$x;
##
##
my $x=1; my $y=1; $x+=1; $y=$x; $x+=$y; $x+=1; $y=$x; $x+=$y;
##
##
my $x=1;my $y=1; $x+=1; $x+=1;$x+=$y ;$y=$x ;$x+=$y ;$x+=$y ;$y=$x ;$x=$y ;
$x+=$y ;$x+=$y ;$x+=$y ;$x+=1;$x+=$y ;$x+=$y ;$y=$x ;$x+=$y ;$x+=$y ;
$x+=$y ;$y=$x ;$x+=$y ;$x+=$y ;$x+=$y ;$y=$x ;$x+=$y ;$x|=$y ;$y=$x ;
$x+=$y ;$x+=$y ;
##
##
#!/usr/bin/perl -w
# An implementation of Genetic programming in Perl.
use strict;
package GenePool;
sub new {
my $class = shift;
my $self = {};
bless ($self, $class);
# Each gene is a Perl statement.
$self->{GENES} = ['$x+=1 ;', '$x=$y ;', '$y=$x ;',
'$x|=$y ;', '$x+=$y ;', ' ;'];
return $self;
}
# Randomly select a gene from the gene pool
sub random_gene {
my $self = shift;
return ${$self->{GENES}}[rand(@{$self->{GENES}})];
}
package Individual;
sub new {
my $class = shift;
my $self = {};
bless ($self, $class);
$self->{LENGTH} = 32;
$self->{GENES} = []; # An array of perl statements.
$self->{NEW_GENES} = []; # The genes of the individual in
# the next generation.
return $self;
}
# create the genes for this individual by randomly choosing
# 30 Genes (Perl statements) from the GenePool.
sub create {
my $self = shift;
my $genebase = GenePool->new();
push (@{$self->{GENES}}, 'my $x=1;my $y=1;');
for my $i (1 .. $self->{LENGTH}) {
push (@{$self->{GENES}}, $genebase->random_gene());
}
}
# Convert the genes into an string of statements that can
# be evaluated using eval().
sub get_code {
my $self = shift;
my $code = "";
map { $code .= $_} (@{$self->{GENES}});
return $code;
}
# Set the new set of genes and do some mutation.
sub set_new_genes {
my $self = shift;
@{$self->{NEW_GENES}} = @_;
# Once in a while there is an error during copying and a
# gene is mutated.
if (rand(1.0) < 0.005) {
my $mutate = 1 + int(rand(@{$self->{NEW_GENES}} - 1));
my $genebase = GenePool->new();
${$self->{GENES}}[$mutate] = $genebase->random_gene();
}
}
# Get a copy of the genes
sub get_genes {
my $self = shift;
return @{$self->{GENES}};
}
# Switch the new genes with the old genes
sub switch_genes {
my $self = shift;
@{$self->{GENES}} = @{$self->{NEW_GENES}};
}
package Population;
sub new {
my $class = shift;
my $self = {};
bless ($self, $class);
$self->{SIZE} = 1999; # The population size
$self->{INDIVIDUALS} = [];
$self->{FITNESSES} = []; # The fitness of each individual
for my $i (0 .. $self->{SIZE}) {
my $individual = Individual->new();
$individual->create();
push (@{$self->{INDIVIDUALS}}, $individual);
}
return $self;
}
# Determine the fitnes of all individuals in the population
sub survival {
my $self = shift;
my $fitnesses = $self->{FITNESSES};
my $i = 0;
foreach my $individual (@{$self->{INDIVIDUALS}}) {
my $value = eval($individual->get_code());
${$fitnesses}[$i] = objective($value);
++$i;
}
}
# Scale the fitnes values such that they are all between 0 and 1
# and such that the total sum is 1.
sub scale {
my $self = shift;
my $fitnesses = $self->{FITNESSES};
my $i;
my $size = $self->{SIZE};
my $min = ${$fitnesses}[0];
for ($i = 0; $i < $size; ++$i) {
$min = ${$fitnesses}[$i] if (${$fitnesses}[$i] < $min);
}
my $sum = 0.0;
for ($i = 0; $i < $size; ++$i) {
${$fitnesses}[$i] -= $min;
$sum += ${$fitnesses}[$i];
}
for ($i = 0; $i < $size; ++$i) {
${$fitnesses}[$i] /= $sum;
}
}
# Function that determines how fit an individual is
# That is how close it comes to the objective. (target number)
# The higher the number the fitter the individual.
sub objective {
my $value = shift;
return -abs(10512 - $value);
}
# Display the fitest individual
sub statistics {
my $self = shift;
my $fitnesses = $self->{FITNESSES};
my $i;
my $index = 0;
my $size = $self->{SIZE};
my $max = ${$fitnesses}[0];
for ($i = 0; $i < $size; ++$i) {
if (${$fitnesses}[$i] > $max) {
$max = ${$fitnesses}[$i];
$index = $i;
}
}
my $individual = ${$self->{INDIVIDUALS}}[$index];
print " ", eval($individual->get_code()), "\n";
print $individual->get_code(), "\n";
}
# Randomly select an individual from the population.
# The fitter an individual it there more likely it is it
# is chosen.
sub choose {
my $self = shift;
my $f = rand(1.0);
my $index = 0;
my $sum = 0.0;
foreach my $fitnes (@{$self->{FITNESSES}}) {
$sum += $fitnes;
return ${$self->{INDIVIDUALS}}[$index] if $sum >= $f;
++$index;
}
die "can't select an individual";
}
# Generate a new poplation out of the old population by
# letting the fitest individuals mate.
sub breed {
my $self = shift;
my $size = $self->{SIZE};
for (my $i = 0; $i < $size;) {
# Get the genes from two randomly chosen (fitest) individuals
my @genes1 = ($self->choose())->get_genes();
my @genes2 = ($self->choose())->get_genes();
my @new_genes1 = @genes1;
my @new_genes2 = @genes2;
# Now either
# (1) copy both genes into the new population or
# (2) select a random cut point and swap the two gene
# halves, that is
# xxxxxxxxx becomes xxxxxyyyy
# yyyyyyyyy yyyyyxxxx
if (rand(1.0) > 0.5) {
my $cut = 1 + int(rand(@genes1 - 1));
splice @new_genes1, $cut;
splice @new_genes2, $cut;
push @new_genes1, (splice @genes2, $cut);
push @new_genes2, (splice @genes1, $cut);
}
${$self->{INDIVIDUALS}}[$i++]->set_new_genes(@new_genes1);
${$self->{INDIVIDUALS}}[$i++]->set_new_genes(@new_genes2);
}
}
# swap the old genes with the newly created genes to get the new
# population.
sub switch {
my $self = shift;
foreach my $individual (@{$self->{INDIVIDUALS}}) {
$individual->switch_genes();
}
}
package main;
my $population = Population->new();
for my $generation (0 .. 100) {
$population->survival();
$population->scale();
$population->statistics();
$population->breed();
$population->switch();
}