use strict;
use warnings;
use Time::HiRes qw[ time ];

srand(308);

my $total_time      = time();
my $target          = 392;
my $population_size = 100;
my $chromosome_size = 100;
my $mutation_rate   = 0.1;
my $crossover_rate  = 0.7;

my $genome     = Genome->new();
my $population = Population->new( $population_size, $chromosome_size );
my $winner     = $population->check_for_winner();

my $duration;
my $generation_counter = 1;

until ($winner) {
	my $generation_time = time();
	$winner =	  $population->regenerate( $crossover_rate, $mutation_rate, $genome, $target );
	printf( "Generation $generation_counter took %.3f seconds to complete\n",time() - $generation_time );
	$generation_counter++;
}

print("Solution reached in generation: $generation_counter \n");
print("The chromosome: @{$winner->{nucleotides}} \n");
print( $winner->{phenotype} . " = " . $winner->{result} . " \n" );
printf( "Total time to reach solution %.3f seconds \n", time() - $total_time );

###########################################################################################################################
package Population;
use List::Util qw[ sum ];

sub new {
	die unless ( scalar(@_) == 3 );
	my ( $class, $population_size, $chromosome_size ) = @_;
	my $self = {
		chromosomes => [map { Chromosome->new($chromosome_size) } ( 1 .. $population_size )	]
	};
	$self->{fitness_score} = get_population_fitness_score($self);
	bless( $self, $class );
	return ($self);

}

sub regenerate {
	die unless ( scalar(@_) == 5 );
	my ( $population, $crossover_rate, $mutation_rate, $genome, $target ) = @_;
	my ($population_size) = scalar( @{ $population->{chromosomes} } );
	my ( @new_chromosomes, $fitness_score );
	my ($new_chromosome_count) = 1;
	while ( $new_chromosome_count < $population_size ) {
		my ($chromosome1)    = get_nonrandom_chromosome($population);
		my ($chromosome2)    = get_nonrandom_chromosome($population);
		my ($new_chromosome) =
		  Chromosome->new_from( $chromosome1, $chromosome2, $crossover_rate,
			$mutation_rate, $genome, $target );
		push( @new_chromosomes, $new_chromosome );
		$new_chromosome_count++;

		#print("$new_chromosome_count ");
	}
	@{ $population->{chromosomes} } = @new_chromosomes;
	$population->{fitness_score} = get_population_fitness_score($population);
	return ( check_for_winner($population) );
}

sub get_nonrandom_chromosome {
	my $population     = shift(@_);
	my $rulet_position = rand( $population->{fitness_score} );
	my $temp_score     = 0;
	my $nonrandom_chromosome;
	foreach my $individual ( @{ $population->{chromosomes} } ) {
		$temp_score += $individual->{fitness_score};
		if ( $temp_score > $rulet_position ) {
			$nonrandom_chromosome = $individual;
			last;
		}
	}
	return ($nonrandom_chromosome);
}

sub check_for_winner {
	die unless ( scalar(@_) == 1 );
	my $population = shift(@_);
	my $winner;

	foreach my $individual ( @{ $population->{chromosomes} } ) {
		if ( $individual->{result} == $target ) {
			$winner = $individual;
			last;
		}
	}
	return ($winner);
}

sub get_population_fitness_score {
	my $population               = shift(@_);
	my $population_fitness_score =
	  sum( map { $_->{fitness_score} } @{ $population->{chromosomes} } );
	return ($population_fitness_score);
}

###########################################################################################################################
package Chromosome;

sub new {
	die unless ( scalar(@_) == 2 );
	my ( $class, $chromosome_size ) = @_;

	my $self = {
		nucleotides   => [],
		phenotype     => undef,
		result        => undef,
		fitness_score => undef
	};

	$chromosome_size = 100 unless ($chromosome_size);
	for my $nucleotide ( 0 .. ( $chromosome_size - 1 ) ) {
		$self->{nucleotides}->[$nucleotide] = int( rand(1) + 0.5 );
	}

	$self->{phenotype}     = get_phenotype( $self, $genome );
	$self->{result}        = get_result($self);
	$self->{fitness_score} = get_fitness_score( $self, $target );

	bless( $self, $class );
	return ($self);

}

sub new_from {
	die unless ( scalar(@_) == 7 );
	my ( $class, $chromosome1, $chromosome2, $crossover_rate, $mutation_rate,
		$genome, $target )
	  = @_;
	my ($self) = {
		nucleotides => [],
		phenotype   => undef,
		result      => undef
	};

	my ($chromosome_size) = scalar( @{ $chromosome1->{nucleotides} } );

	die
	  unless ( $chromosome_size == scalar( @{ $chromosome2->{nucleotides} } ) );

	my @new_nucleotides;
	if ( rand(1) < $crossover_rate ) {
		my $crossover_point = int( rand($chromosome_size) );
		@new_nucleotides = (
			@{$chromosome1->{nucleotides}}[ 0 .. $crossover_point ],
			@{$chromosome2->{nucleotides}}[ ( $crossover_point + 1 ) .. ($chromosome_size-1) ]
		);
	}
	else {
		if ( rand(1) > 0.5 ) {
			@new_nucleotides = @{ $chromosome1->{nucleotides} };
		}
		else {
			@new_nucleotides = @{ $chromosome2->{nucleotides} };
		}
	}
	if ( rand(1) < $mutation_rate ) {
		my $nucleotide_pos = int( rand($chromosome_size) );
		if ( $new_nucleotides[$nucleotide_pos] ) {
			$new_nucleotides[$nucleotide_pos] = 0;
		}
		else {
			$new_nucleotides[$nucleotide_pos] = 1;
		}
	}

	$self->{nucleotides}   = \@new_nucleotides;
	$self->{phenotype}     = get_phenotype( $self, $genome );
	$self->{result}        = get_result($self);
	$self->{fitness_score} = get_fitness_score( $self, $target );

	bless( $self, $class );
	return ($self);
}

sub get_phenotype {
	die unless ( scalar(@_) == 2 );
	my ( $chromosome, $genome ) = @_;
	my @phenotype           = ();
	my @expressed_phenotype = ();
	my @nucleotides         = @{ $chromosome->{nucleotides} };
	my @gene                = ();
	my $pattern             = q(\d);

	foreach my $nucleotide (@nucleotides) {

		if ( scalar(@gene) >= $genome->{gene_length} ) {
			my $gene = join( "", @gene );
			@gene = ($nucleotide);
			if ( $genome->{gene_codes}->{$gene} ) {
				push( @phenotype, $genome->{gene_codes}->{$gene} );
			}
		}
		else {
			push( @gene, $nucleotide );
		}

	}

	foreach my $item (@phenotype) {
		if ( $item =~ m/$pattern/ ) {
			push( @expressed_phenotype, $item );
			if ( $pattern eq q(\d) ) {
				$pattern = q(\D);
			}
			else {
				$pattern = q(\d);
			}
		}
	}

	if ( $expressed_phenotype[$#expressed_phenotype] =~ m/\D/ ) {
		pop(@expressed_phenotype);
	}
	return ( join( "", @expressed_phenotype ) );
}

sub get_result {
	die unless ( scalar(@_) == 1 );
	my ($chromosome) = @_;
	my $result = eval( $chromosome->{phenotype} );
	return ($result);
}

sub get_fitness_score {
	die unless ( scalar(@_) == 2 );
	my ( $chromosome, $target ) = @_;
	my $result        = $chromosome->{result};
	my $fitness_score =
	  ( $target / ( $target + abs( $target - $result ) ) ) * 3;
	return ($fitness_score);
}

###########################################################################################################################
package Genome;

sub new {
	my $self = {
		gene_codes  => {},
		gene_length => undef
	};
	my $class      = shift(@_);
	my $gene_codes = shift(@_);

	if ($gene_codes) {
		$self->{gene_codes} = $gene_codes;
		gene_length($self);
	}
	else {
		$self->{gene_codes} = {
			'0001' => '1',
			'0010' => '2',
			'0011' => '3',
			'0100' => '4',
			'0101' => '5',
			'0110' => '6',
			'0111' => '7',
			'1000' => '8',
			'1001' => '9',
			'1010' => '+',
			'1011' => '-',
			'1100' => '*',
			'1101' => '/'
		};
		$self->{gene_length} = 4;

	}

	bless( $self, $class );
	return ($self);
}

sub gene_length {
	my $self = shift(@_);
	die "Invalid Genome"
	  unless ($self);
	if ( $self->{gene_length} ) {
		return ( $self->{gene_length} );
	}
	else {
		my @gls =
		  sort( map { length($_) } ( keys( %{ $self->{gene_codes} } ) ) );
		die("Invalid Genome") unless ( $gls[0] == $gls[$#gls] );
		$self->{gene_length} = $gls[0];
		return ( $gls[0] );
	}
}