I'm new to perl and to try it out a bit more seriously I took on an AI genetic algorythm problem (details of the problem here: http://www.ai-junkie.com/ga/intro/gat1.html). I coded the same problem in java some time ago, and was initially supprised that java was faster then perl, but thanks to help I got here I eventually developed a rasonably fast Perl script (attached here, but see also http://www.perlmonks.org/?node_id=876119). I developed it as a purely procedural solution. The next thing for me, of course, was to try out OO Perl. I rewrote the code, this time using objects, expecting it to work measurabely slower. To my great suprise the OO version seems to work faster despite having more lines of code and additional complexity. Can anyone explain why? Also it seems that the OO version accellerates, which I found even more bizzare. If you run the code attached here it becomes obvious what I mean by accellerates. Thanks again, Christian

Sorry for lengthy listings...

***********************

Here is the Procedural Perl version

use strict;
use warnings;
use List::Util qw[ sum ];
use Time::HiRes qw[ time ];

srand(100);

my $total_time = time();
my $target          = 379;
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]

****************************************

Here is the OO version - all classess are in the same file

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 compl
+ete\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() - $tota
+l_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, $targe
+t ) = @_;
    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($popul
+ation);
    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, $mutatio
+n_rate,
        $genome, $target )
      = @_;
    my ($self) = {
        nucleotides => [],
        phenotype   => undef,
        result      => undef
    };

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

    die
      unless ( $chromosome_size == scalar( @{ $chromosome2->{nucleotid
+es} } ) );

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

[download]

In reply to Procedural Perl slower than OO Perl!!! 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.