use strict; use warnings; use List::Util qw[ sum ]; use Time::HiRes qw[ time ]; #use Math::Complex; #use Win32; my $total_time = time(); my $target = 100; my $population_size = 100; my $chromosome_size = 100; my $mutation_rate = 0.1; my $crossover_rate = 0.7; my @population = (); my @phenotypes = (); my @results = (); 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 $gene_length = get_gene_length( \%genome ); my $duration; my $generation_counter = 1; my $winner; do { my $generation_time = time(); @population = @{ regenrate_population( \@population ) }; $winner = check_for_winner( \@population ); printf( "Generation $generation_counter took %.3f seconds to complete\n", time() - $generation_time ); $generation_counter++; } until ($winner); print("Solution reached in generation: $generation_counter \n"); print("The chromosome: @{$winner->{chromosome}} \n"); print( $winner->{phenotype} . " = " . $winner->{result} . " \n" ); printf( "Total time to reach solution %.3f seconds \n", time() - $total_time ); sub regenrate_population { my $old_population = shift(@_); my $new_population = []; if ( $old_population->[0] ) { my $population_fitness_score=get_population_fitness_score($old_population); for my $individual ( 0 .. ($population_size) ) { my $chromosome1 = get_nonrandom_chromosome($old_population,$population_fitness_score); my $chromosome2 = get_nonrandom_chromosome($old_population,$population_fitness_score); $new_population->[$individual]->{chromosome} = get_child( $chromosome1, $chromosome2 ); $new_population->[$individual]->{phenotype} = get_phenotype( $new_population->[$individual]->{chromosome} ); $new_population->[$individual]->{result} = get_result( $new_population->[$individual]->{phenotype} ); $new_population->[$individual]->{fitness_score} = get_fitness_score( $new_population->[$individual]->{result} ); } } else { for my $individual ( 0 .. $population_size ) { for my $nucleotide ( 0 .. $chromosome_size ) { $new_population->[$individual]->{chromosome}->[$nucleotide] = int( rand(1) + 0.5 ); } $new_population->[$individual]->{phenotype} = get_phenotype( $new_population->[$individual]->{chromosome} ); $new_population->[$individual]->{result} = get_result( $new_population->[$individual]->{phenotype} ); $new_population->[$individual]->{fitness_score} = get_fitness_score( $new_population->[$individual]->{result} ); } } return ($new_population); } sub check_for_winner { my $winner; my $population = shift(@_); foreach my $individual (@$population) { if ( $individual->{result} == $target ) { $winner = $individual; last; } } return ($winner); } sub get_nonrandom_chromosome { my $population=shift(@_); my $population_fitness_score = shift(@_); my $rulet_position = rand($population_fitness_score); my $temp_score = 0; my $nonrandom_chromosome; foreach my $individual (@$population) { $temp_score += $individual->{fitness_score}; if ( $temp_score > $rulet_position ) { $nonrandom_chromosome = $individual->{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) ); $new_chromosome = [ @$chromosome1[ 0 .. $crossover_point ], @$chromosome2[ ( $crossover_point + 1 ) .. ($chromosome_size) ] ]; } 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 = shift(@_); my $population_fitness_score = sum( map { $_->{fitness_score} } (@$population) ); return ($population_fitness_score); } sub get_result { my $phenotype = shift(@_); my $result = eval($phenotype) ; return ($result); } sub get_fitness_score { my $result = shift(@_); my $fitness_score = ( $target / ( $target + abs( $target - $result ) ) ) * 3; return ($fitness_score); } sub get_phenotype { my $chromosome = shift(@_); my @phenotype = (); my @expressed_phenotype = (); 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 get_gene_length { my $genome = shift(@_); 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] ); }