#!/usr/bin/perl
package GenePool;
sub new {
	my $class = shift;
	my $self = {};
	bless($self, $class);
	$self->{GENES} = [
		'$x+=1;', '$y+=1;',
		'$X-=1;', '$y-=1;',
		'$X+=$y;', '$y+=$x;',
		'$x-=$y;', '$y-=$x;',
		';' ];
	return $self;
}
sub gene {
	my $self = shift;
	return ${$self->{GENES}}[rand(@{$self->{GENES}})];
}

package Organism;
sub new {
	my $class = shift;
	my $self = {};
	bless($self, $class);
	$self->{LENGTH} = 12;
	$self->{GENES} = [];
	$self->{NEXTGEN} = [];
	return $self;
}
#create genes for this organism by selecting genes from the genepool
sub initialize {
	my $self = shift;
	my $genepool = GenePool->new();
	foreach (1..$self->{LENGTH}){
		push(@{$self->{GENES}}, $genepool->gene());
	}
	return;
}
sub set_nextgen {
	my $self = shift;
	@{$self->{NEXTGEN}} = @_;
	return;
}
sub age {
	my $self = shift;
	@{$self->{GENES}} = @{$self->{NEXTGEN}} unless $#{$self->{NEXTGEN}} == -1;
	return;
}
sub get_genes {
	my $self = shift;
	return @{$self->{GENES}};
}
#return code to be evaluated
sub get_code {
	my $self = shift;
	my $code = "";
	foreach(@{$self->{GENES}}){ $code .= $_; }
	return $code;
}

package Population;
sub new {
	my ($class, $size) = @_;
	my $self = {};
	bless($self, $class);
	$size++ if $size%2 == 0;
	$size+=2 if ($size+1)%4 != 0;
	$self->{SIZE} = $size;
	$self->{ORGANISMS} = [];
	$self->{FITNESSES} = [];
	$self->{OBJECTIVE} = "";
	$self->{VERBOSE} = "";
	$self->{MIDDLE} = 0;
	foreach (0..$self->{SIZE}){
		my $organism = Organism->new();
		$organism->initialize;
		push(@{$self->{ORGANISMS}}, $organism);
	}
	return $self;
}
sub set_verbosity {
	my $self = shift;
	$self->{VERBOSE} = shift;
	return;
}
sub get_verbosity {
	my $self = shift;
	return $self->{VERBOSE};
}
sub set_objective {
	my $self = shift;
	$self->{OBJECTIVE} = shift;
	return;
}
sub get_objective {
	my $self = shift;
	return $self->{OBJECTIVE};
}
#determine the fitnesses of each organism
sub fitness {
	my $self = shift;
	my $f = $self->{FITNESSES};
	my $i = 0;
print STDERR "\nFITNESS OF GENEPOOL evaluation(code_value)\n" if $self->{VERBOSE};
	foreach my $organism (@{$self->{ORGANISMS}}){
		my $val = eval('my $x = 1; my $y = 1;' . $organism->get_code());
		${$f}[$i] = $self->evaluate($val);
	print STDERR ${$f}[$i] . "($val)" if $self->{VERBOSE};
		$i++;
	}
	print STDERR "\n" if $self->{VERBOSE};
	return;
}
sub evaluate {
	my ($self, $val) = @_;
	return -abs($self->{OBJECTIVE} - $val);
}
#scale the fitnesses so they are less than one and add to one
sub scale_fitness {
	my $self = shift;
	my $fitnesses = $self->{FITNESSES};
	my $i;
	my $min = ${$fitnesses}[0];
	my $size = $self->{SIZE};
	my $sum = 0.0;
	for ($i = 0; $i <= $size; ++$i ){
		$min = ${$fitnesses}[$i] if ${$fitnesses}[$i] < $min;
	}
	for ( $i = 0; $i <= $size; ++$i ){
		${$fitnesses}[$i] -= $min;
		$sum += ${$fitnesses}[$i];
	}
	for ( $i = 0; $i <= $size; ++$i ){
		if($sum != 0){
			${$fitnesses}[$i] /= $sum;
		}else{
			${$fitnesses}[$i] = 1/$#{$fitnesses};
		}
	}
	return;
}
#pick the fitest individual, excepting those we are told to ignore
# (which are the previous picks)
sub select {
	my ($self, $type, @excludelist) = @_;
	my $index = 0;
	my ($fitest, $ffit);
	$ffit = 1.0 if $type eq 'least fit';
	foreach my $fitness (@{$self->{FITNESSES}}){
		my $next = "";
		foreach (@excludelist){
			if($index == $_){
				$next = "next";
				last;
				}}
		$index++;
		next if $next eq "next";
		if ( (($type eq 'fitest') && ($ffit <= $fitness)) ||
			(($type eq 'least fit') && ($ffit >= $fitness)) ){
			$fitest = $index - 1;
			$ffit = $fitness;
		}
	}
	return ${$self->{ORGANISMS}}[$fitest], $fitest;
}
sub find_middle {
	my $self = shift;
	my $f = 0;
	foreach my $fitness (@{$self->{FITNESSES}}){
		$f += $fitness;
	}
	$self->{MIDDLE} = $f/(@{$self->{FITNESSES}}+1);
	return;
}
#find the individual who's fitness is nearest the "middle"
sub find_nearest_middle {
	my $self = shift;
	my $middle = $self->{MIDDLE};
	my ($nearest, $n, $i);
	foreach (@{$self->{FITNESSES}}){
		if ( abs($nearest - $middle) > abs($_ - $middle)){
			$nearest = $_;
			$n = $i;
		}
		$i++;
	}
	return ${$self->{ORGANISMS}}[$n];
}
sub mutate {
	my @genes = @_;
	my $genepool = GenePool->new();
	foreach my $i (0..$#genes){
		$genes[$i] = $genepool->gene if rand(1.0) > 0.825;
	}
	return @genes;
}
#produce offspring for the next generation
sub mate {
	my $self = shift;
	my $size = $self->{SIZE};
	my @minexcludes = ();
	my @maxexcludes = ();
	
	for ( my $i = 0;  $i < $size; $i+=4 ){
		my $chance = rand(1.0);
		if($chance > 0.5){
			my (@genes_one, @genes_two, $org_one, $org_two, $index_one, $index_two);
			($org_one, $index_one) = $self->select('fitest', @maxexcludes);
			push(@maxexcludes, $index_one);
			@genes_one = $org_one->get_genes();
			($org_two, $index_two) = $self->select('fitest', @maxexcludes);
			push(@maxexcludes, $index_two);
			@genes_two = $org_two->get_genes();
			my @new_genes_one = @genes_one;
			my @new_genes_two = @genes_two;

			my $point = 1 + int(rand(@genes_one - 1));
			splice @new_genes_one, $point;
			splice @new_genes_two, $point;
			push @new_genes_one, (splice @genes_two, $point);
			push @new_genes_two, (splice @genes_one, $point);

			my (undef, $min_one) = $self->select('least fit', @minexcludes);
			push(@minexcludes, $min_one);
			my (undef, $min_two) = $self->select('least fit', @minexcludes);
			push(@minexcludes, $min_two);			
			${$self->{ORGANISMS}}[$min_one]->set_nextgen(@new_genes_one);
			${$self->{ORGANISMS}}[$min_two]->set_nextgen(@new_genes_two);
		}elsif($chance < 0.05){
			if(rand(1.0)>0.5){
				my (@genes_one, $org_one, $index_one);
				($org_one, $index_one) = $self->select('fitest', @maxexcludes);
				push(@maxexcludes, $index_one);
				@genes_one = $org_one->get_genes();
				my @new_genes_one = @genes_one;
		
				@new_genes_one = mutate(@genes_one);

				my (undef, $min_one) = $self->select('least fit', @minexcludes);
				push(@minexcludes, $min_one);
				${$self->{ORGANISMS}}[$min_one]->set_nextgen(@new_genes_one);
			}else{
				my (@genes_two, $org_two, $index_two);
				($org_two, $index_two) = $self->select('fitest', @maxexcludes);
				push(@maxexcludes, $index_two);
				@genes_two = $org_two->get_genes();
				my @new_genes_two = @genes_two;
		
				@new_genes_two = mutate(@genes_two);

				my (undef, $min_two) = $self->select('least fit', @minexcludes);
				push(@minexcludes, $min_two);			
				${$self->{ORGANISMS}}[$min_two]->set_nextgen(@new_genes_two);
			}
		}
	}
	return;
}
sub generate {
	my $self = shift;
	foreach my $organism (@{$self->{ORGANISMS}}){
		$organism->age();
	}
	return;
}

package Statistics;
sub new {
	my $class = shift;
	my $self = {};
	bless($self, $class);
	$self->{GRADE} = [ ' ', 'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I',
		'J', 'K', 'L', 'M', 'N', 'O', 'P', 'Q', 'R', 'S', 'T', 'U',
		'V', 'W', 'X', 'Y', 'Z' ];
	return $self;
}
sub grade_fitest { 
	my ($self, $pop) = @_;
	my ($best, undef) = ${$pop->{ORGANISMS}}[$pop->select('fitest')];
	my $indexorg = eval('my $x=1; my $y=1;' . $best->get_code());
	my $index = $indexorg;
	my $obj = $pop->get_objective();
	if($index < 0){
		$index = abs($index) + 1 + $obj;
	}
	return "*", $indexorg if $index > 26;
	return ${$self->{GRADE}}[$index], $indexorg;
}
sub show_fitest {
	my ($self, $pop) = @_;
	my ($best, undef) = ${$pop->{ORGANISMS}}[$pop->select('fitest')];
	return $best->get_code();
}
sub show_middle {
	my ($self, $pop) = @_;
	$pop->find_middle;
	my $middle = $pop->find_nearest_middle();
	my $indexorg = eval('my $x=1; my $y=1;' . $middle->get_code());
	my $index = $indexorg;
	my $obj = $pop->get_objective();
	if($index < 0){
		$index = abs($index) + 1 + $obj;
	}
	return "*", $indexorg if $index > 26;
	return ${$self->{GRADE}}[$index], $indexorg;
}

package main;

$|=1;

my @string = (10, 21, 19, 20, 0, 14, 15, 20, 8, 5, 18, 0, 16, 5, 18, 12, 0, 8, 1, 3, 11, 5, 18);
my (@kings, @halloffame);

foreach my $target (@string){
	my $population = Population->new(49);
	$population->set_objective($target);
	#$population->set_verbosity(1);
	my $generation = 0;
	my $found = 0;
	while(!$found){
		print "Generation[$generation]";
		$population->fitness();
		$population->scale_fitness();
		my $statistics = Statistics->new();
		my ($grade, $val) = $statistics->grade_fitest($population);
		my $fitest = $statistics->show_fitest($population);
		print join("", @kings) . $grade;
		$population->mate();
		$population->generate();
		if($val == $target){
			print "\n$fitest\n";
			$found++;
			push(@kings, $grade);
			push(@halloffame, $fitest);
		}elsif($population->get_verbosity){
			my ($grade, $val) = $statistics->show_middle($population);
			print " ($grade, $val)";
		}
		print "\n" unless $found;
		$generation++;
	}
}
print "\nHALL OF FAME\n", join("\n", @halloffame);