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).
UPDATE: RE-ADDED CODE
#!/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();
}
-
Are you posting in the right place? Check out Where do I post X? to know for sure.
-
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big>
<blockquote> <br /> <dd>
<dl> <dt> <em> <font>
<h1> <h2> <h3> <h4>
<h5> <h6> <hr /> <i>
<li> <nbsp> <ol> <p>
<small> <strike> <strong>
<sub> <sup> <table>
<td> <th> <tr> <tt>
<u> <ul>
-
Snippets of code should be wrapped in
<code> tags not
<pre> tags. In fact, <pre>
tags should generally be avoided. If they must
be used, extreme care should be
taken to ensure that their contents do not
have long lines (<70 chars), in order to prevent
horizontal scrolling (and possible janitor
intervention).
-
Want more info? How to link
or How to display code and escape characters
are good places to start.