performance measurements

Each table row shows performance measurements for this Perl program with a particular command-line input value N.

 N  CPU secs Elapsed secs Memory KB Code B ≈ CPU Load

Read the ↓ make, command line, and program output logs to see how this program was run.

Read chameneos-redux benchmark to see what this program should do.

 notes

This is perl 5, version 18, subversion 0 (v5.18.0) built for x86_64-linux-thread-multi

Compile-time options: HAS_TIMES MULTIPLICITY PERLIO_LAYERS
                        PERL_DONT_CREATE_GVSV
                        PERL_HASH_FUNC_ONE_AT_A_TIME_HARD
                        PERL_IMPLICIT_CONTEXT PERL_MALLOC_WRAP
                        PERL_PRESERVE_IVUV PERL_SAWAMPERSAND USE_64_BIT_ALL
                        USE_64_BIT_INT USE_ITHREADS USE_LARGE_FILES
                        USE_LOCALE USE_LOCALE_COLLATE USE_LOCALE_CTYPE
                        USE_LOCALE_NUMERIC USE_PERLIO USE_PERL_ATOF
                        USE_REENTRANT_API

 chameneos-redux Perl program source code

# The Computer Language Benchmark Game
# http://benchmarksgame.alioth.debian.org/
# contributed by Daniel Green 2010-4-1
#  a transliteration of Python 3 #2

use 5.10.0;
use strict;
use warnings;
use threads;
use threads::shared;
use Thread::Semaphore;
use List::Util qw(sum);

my @creature_colors = qw(blue red yellow);

sub complement {
    my ($c1, $c2) = @_;

    if ($c1 eq $c2) {
        return $c1;
    } elsif ($c1 eq 'blue') {
        if ($c2 eq 'red') {
            return 'yellow';
        } else {
            return 'red';
        }
    } elsif ($c1 eq 'red') {
        if ($c2 eq 'blue') {
            return 'yellow';
        } else {
            return 'blue';
        }
    } elsif ($c2 eq 'blue') {
        return 'red';
    } else {
        return 'blue';
    }
}

my %compl_dict;
foreach my $c1 (@creature_colors) {
    foreach my $c2 (@creature_colors) {
        $compl_dict{"$c1,$c2"} = complement($c1, $c2);
    }
}

sub check_complement {
    foreach my $c1 (@creature_colors) {
        foreach my $c2 (@creature_colors) {
            say "$c1 + $c2 -> " . $compl_dict{"$c1,$c2"};
        }
    }

    say '';
}

sub spellout {
    my ($n) = @_;

    my @numbers = qw(zero one two three four five six seven eight nine);

    return ' ' . join(' ', map { $numbers[$_] } split //, $n);
}

sub report {
    my ($input_zoo, $met, $self_met) = @_;

    say ' ' . join(' ', @{$input_zoo});

    for (my $x = 0; $x < scalar @{$met}; $x++) {
        say $met->[$x] . spellout($self_met->[$x]);
    }

    say spellout(sum(@{$met})) . "\n";
}

sub creature {
    my ($my_id, $venue, $my_lock, $in_lock, $out_lock) = @_;

    while (1) {
        $my_lock->down();
        $in_lock->down();

        $venue->[0] = $my_id;
        $out_lock->up();
    }
}

sub let_them_meet {
    my ($meetings_left, $input_zoo) = @_;

    my $c_no = scalar @{$input_zoo};
    my @venue :shared = (-1);
    my @met = (0) x $c_no;
    my @self_met = (0) x $c_no;
    my @colors = @{$input_zoo};

    my $in_lock = Thread::Semaphore->new();
    $in_lock->down();
    my $out_lock = Thread::Semaphore->new();
    $out_lock->down();
    
    my @locks;
    for my $ci (0 .. $c_no - 1) {
        $locks[$ci] = Thread::Semaphore->new();
        threads->new(\&creature, $ci, \@venue, $locks[$ci], $in_lock, $out_lock)->detach();
    }

    $in_lock->up();
    $out_lock->down();
    my $id1 = $venue[0];
    while ($meetings_left > 0) {
        $in_lock->up();
        $out_lock->down();
        my $id2 = $venue[0];
        if ($id1 != $id2) {
            my $new_color = $compl_dict{"$colors[$id1],$colors[$id1]"};
            $colors[$id1] = $new_color;
            $colors[$id2] = $new_color;
            $met[$id1] += 1;
            $met[$id2] += 1;
        } else {
            $self_met[$id1] += 1;
            $met[$id1] += 1;
        }
        $meetings_left -= 1;
        if ($meetings_left > 0) {
            $locks[$id1]->up();
            $id1 = $id2;
        } else {
            report($input_zoo, \@met, \@self_met);
        }
    }
}

check_complement();
let_them_meet($ARGV[0], ['blue', 'red', 'yellow']);
let_them_meet($ARGV[0], ['blue', 'red', 'yellow', 'red', 'yellow', 'blue', 'red', 'yellow', 'red', 'blue']);

 make, command-line, and program output logs

Mon, 04 Feb 2013 05:20:38 GMT

COMMAND LINE:
/usr/local/src/perl-5.16.2/bin/perl chameneosredux.perl 6000000

PROGRAM OUTPUT:
blue + blue -> blue
blue + red -> yellow
blue + yellow -> red
red + blue -> yellow
red + red -> red
red + yellow -> blue
yellow + blue -> red
yellow + red -> blue
yellow + yellow -> yellow

 blue red yellow
4064727 zero
4011574 zero
3923699 zero
 one two zero zero zero zero zero zero

 blue red yellow red yellow blue red yellow red blue
1217957 zero
1206854 zero
1202570 zero
1192888 zero
1201974 zero
1183838 zero
1201158 zero
1189168 zero
1205942 zero
1197651 zero
 one two zero zero zero zero zero zero

Revised BSD license

  Home   Conclusions   License   Play