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