This is a follow up on the discussion Be a monkey! about getting monkeys to write a Shakespeare novel by randomly typing on a typewriter. I have translated this into the following programming challenge:

Write a Perl program that given a limited number of statements, creates a number that comes as close as possible to some target number. The program starts with

my $x=1; my $y=1;

which is followed by a combination of at most 30 statements chosen from the following 5 statements:

$x += 1; $x =$y; $x |=$y; $x +=$y; $y =$x;

The last statement of the program is the result of the program.

For instance if the target number is 10, a possible solution is:

my $x=1; my $y=1; $x+=1; $y=$x; $x+=$y; $x+=1; $y=$x; $x+=$y;

Such a program is easy to find for small number. It is harder for larger numbers. For instance a solution for 10512 is:

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 ;

There are 6^30 = 2.2 * 10^23 ways to combine the 5 statements into a program of at most 30 of such statements. 6^30 = 2.2*10^23, which makes it quite impossible to just search all possible combinations for an answer. Randomly generating such programs is about as likely to find an answer as a monkey writing one or two lines of Shakespeare by randomly typing.

However the following program does find an exact solution or a close approximation to the target number. It uses the technique of genetic programming, based on natural selection.

It works with a population of individuals. Each individual has 30 genes. Each gene is a Perl statement. To evaluate the fitness of an individual these statements are stringed together into a Perl program. This program is then evaluated using eval(). The better this program is as creating the target number, the fitter the individual.

The population cycles through a number of generations, in which a new population is generated (bred) from the old population. Pairs of individual are formed and they get two children. Each child is either an exact copy of one of one of its parents or a recombination of its parents. Which individuals are to become parents is based on their fitness (how well they did at reaching the target number). The fitter the individual the more offspring it has.

After this all parents die and the cycle repeats.

Generation after generation the population will become better at creating the target number. The nice quality of this technique is that no knowledge about the search space is needed. The only thing you need to define is a function that tells how good a particular solution is. Try changing the Gene base (possible Perl statements) or the target number. Not that there is no intelligence behind the process, but it can come-up with surprising solutions. Would be a good technique to create obfuscated code. :)

It is ofcourse not a solution to all problems, for instance it does not work if there is only one good solution in the entire search-space. There must be intermediate solutions too. However it can be used to solve very hard problems. For instance I use a modified version of this program to solve the problem of how to pack 256 connections of varying capacity into 32 links. This has a search space of 2*10^385. Searching this would require more time then the life time of the current universe and many that come after it :)

This is my first attempt of using OO in Perl. So please point-out any improvements. (I used the cookbook and the Perl FAQ as information sources).


#!/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(); }