use strict;
use warnings;
use Math::Complex;
use Win32;

my $target          = 100;
my $population_size = 50;
my $chromosome_size = 100;
my $mutation_rate   = 0.1;
my $crossover_rate  = 0.7;
my @population      = ();
my %genome          = (
	'0001' => '1',
	'0010' => '2',
	'0011' => '3',
	'0100' => '4',
	'0101' => '5',
	'0110' => '6',
	'0111' => '7',
	'1000' => '8',
	'1001' => '9',
	'1010' => '+',
	'1011' => '-',
	'1100' => '*',
	'1101' => '/'
);

my $duration;
initialise_population();
my $generation_counter = 1;
my $winner             = check_for_winner();
until ($winner) {
	print(
		"generation $generation_counter time: " . Win32::GetTickCount . " \n" );
	@population = regenrate_population();
	$winner     = check_for_winner();
	$generation_counter++;
}
print("Solution reached in generation: $generation_counter \n");
print("The chromosome: @$winner \n");
print( get_phenotype($winner) . " = " . get_result($winner) . " \n" );

sub regenrate_population {
	my @new_population = ();
	for my $i ( 0 .. ( $population_size - 1 ) ) {
		my $chromosome1 = get_nonrandom_chromosome();
		my $chromosome2 = get_nonrandom_chromosome();
		$new_population[$i] = get_child( $chromosome1, $chromosome2 );
	}
	return (@new_population);
}

sub check_for_winner {
	my $winner;
	foreach my $chromosome (@population) {
		if ( get_result($chromosome) == $target ) {
			$winner = $chromosome;
			last;
		}
	}
	return ($winner);
}

sub get_nonrandom_chromosome {
	my $population_fitness_score = get_population_fitness_score();
	my $rulet_position           = rand($population_fitness_score);
	my $temp_score               = 0;
	my $nonrandom_chromosome;
	foreach my $chromosome (@population) {
		$temp_score += get_fitness_score($chromosome);
		if ( $temp_score > $rulet_position ) {
			$nonrandom_chromosome = $chromosome;
			last;
		}
	}
	return ($nonrandom_chromosome);
}

sub get_child {
	my $chromosome1 = shift(@_);
	my $chromosome2 = shift(@_);
	my $new_chromosome;
	if ( rand(1) < $crossover_rate ) {
		my $crossover_point = int( rand($chromosome_size) );
		for my $i ( 0 .. ( $chromosome_size - 1 ) ) {
			if ( $i < $crossover_point ) {
				push( @$new_chromosome, @$chromosome1[$i] );
			}
			else {
				push( @$new_chromosome, @$chromosome2[$i] );
			}
		}
	}
	else {
		if ( rand(1) > 0.5 ) {
			$new_chromosome = $chromosome1;
		}
		else {
			$new_chromosome = $chromosome2;
		}
	}
	if ( rand(1) < $mutation_rate ) {
		my $nucleotide_pos = int( rand($chromosome_size) );
		if ( $$new_chromosome[$nucleotide_pos] ) {
			$$new_chromosome[$nucleotide_pos] = 0;
		}
		else {
			$$new_chromosome[$nucleotide_pos] = 1;
		}
	}
	return ($new_chromosome);
}

sub get_population_fitness_score {
	my $population_fitness_score = 0;
	foreach my $chromosome (@population) {
		$population_fitness_score += get_fitness_score($chromosome);
	}
	return ($population_fitness_score);
}
sub get_result {
	my $chromosome = shift(@_);
	my $phenotype  = get_phenotype($chromosome);
	my $result     = eval($phenotype);
	return ($result);
}

sub get_fitness_score {
	my $chromosome    = shift(@_);
	my $result        = get_result($chromosome);
	my $fitness_score =
	  ( $target / ( $target + abs( $target - $result ) ) ) * 3;
}

sub initialise_population {
	for my $chromosome ( 0 .. $population_size ) {
		for my $nucleotide ( 0 .. $chromosome_size ) {
			$population[$chromosome]->[$nucleotide] = int( rand(1) + 0.5 );
		}
	}
}

sub get_phenotype {
	my $chromosome          = shift(@_);
	my @phenotype           = ();
	my @expressed_phenotype = ();
	my $gene_length         = gene_length();
	my @nucleotides         = @$chromosome;
	my @gene                = ();
	my $pattern             = q(\d);

	foreach my $nucleotide (@nucleotides) {

		if ( scalar(@gene) >= $gene_length ) {
			my $gene = join( "", @gene );
			@gene = ($nucleotide);
			if ( defined( $genome{$gene} ) ) {
				push( @phenotype, $genome{$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 gene_length {
	my @gls = ();
	foreach my $key ( keys(%genome) ) {
		push( @gls, length($key) );
	}
	@gls = sort(@gls);
	if ( $gls[0] != $gls[$#gls] ) {
		die("Invalid genotype");
	}
	return ( $gls[0] );
}