I could not follow all of your code, but it seems it always produces the same solution, which may mean that it does not do what it is supposed to.

Anyhow, taking on all the advice I got here (I have to admit I'm impressed with the answers I got - Thanks guys) I optimised the code and the current version runs over 100 times faster than the first one!!! I am very pleased with it actually :-)

Having said that, I just cannot see why would one generation in the first version take about 2.5 seconds (on my machine) and the current one only 25 milliseconds. It doesn't seem that the new version does 100 times less calculation.

It would be nice if someone opened my eyes. Anyway... Here is the latest optimised code. Thanks

Christian

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 compl
+ete\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]->{chromoso
+me} );
            $new_population->[$individual]->{result} =
              get_result( $new_population->[$individual]->{phenotype} 
+);
            $new_population->[$individual]->{fitness_score} =
              get_fitness_score( $new_population->[$individual]->{resu
+lt} );
        }
    }
    else {
        for my $individual ( 0 .. $population_size ) {
            for my $nucleotide ( 0 .. $chromosome_size ) {
                $new_population->[$individual]->{chromosome}->[$nucleo
+tide] =
                  int( rand(1) + 0.5 );
            }
            $new_population->[$individual]->{phenotype} =
              get_phenotype( $new_population->[$individual]->{chromoso
+me} );
            $new_population->[$individual]->{result} =
              get_result( $new_population->[$individual]->{phenotype} 
+);
            $new_population->[$individual]->{fitness_score} =
              get_fitness_score( $new_population->[$individual]->{resu
+lt} );

        }

    }
    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_si
+ze) ]
        ];
    }
    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] );
}

[download]

In reply to Re^2: Perl slower than java (perl 12x faster than Java) by Christian888
in thread Perl slower than java by Christian888

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.