The Computer Language
Benchmarks Game

chameneos-redux Perl #4 program

# The Computer Language Benchmarks Game
# http://benchmarksgame.alioth.debian.org/
# contributed by Jonathan DePeri 2010/5
# based on an earlier version by Jesse Millikan
# uses Perl interpreter threads with pthreads-like cond_wait and cond_signal
# Modified by Andrew Rodland, August 2010

use threads;
use threads::shared;

my %color = (
  blue => 1,
  red => 2,
  yellow => 4,
);

my @colors;
@colors[values %color] = keys %color;

my @complement;
for my $triple (
  [qw(blue blue blue)],
  [qw(red red red)],
  [qw(yellow yellow yellow)],
  [qw(blue red yellow)],
  [qw(blue yellow red)],
  [qw(red blue yellow)],
  [qw(red yellow blue)],
  [qw(yellow red blue)],
  [qw(yellow blue red)],
) {
  $complement[ $color{$triple->[0]} | $color{$triple->[1]} ] = $color{$triple->[2]};
}

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

sub display_complements
{
  for my $i (1, 2, 4) {
    for my $j (1, 2, 4) {
      print "$colors[$i] + $colors[$j] -> $colors[ $complement[$i | $j] ]\n";
    }
  }
  print "\n";
}

sub num2words {
  join ' ', '', map $numbers[$_], split //, shift;
}

my @creatures : shared;
my $meetings : shared;
my $first : shared = undef;
my $second : shared = undef;
my @met : shared;
my @met_self : shared;

sub chameneos
{
   my $id = shift;

   while (1) {
      lock $meetings;
      last unless $meetings;

      if (defined $first) {
         cond_signal $meetings;
         $creatures[$first] = $creatures[$id] = $complement[$creatures[$first] | $creatures[$id]];
         $met_self[$first]++ if ($first == $id);
         $met[$first]++;  $met[$id]++;
         $meetings --;
         undef $first;
      } else {
         $first = $id;
         cond_wait $meetings;
      }
   }
}

sub pall_mall
{
   my $N = shift;
   @creatures = map $color{$_}, @_;
   my @threads;

   print " ", join(" ", @_);

   $meetings = $N;
   for (0 .. $#creatures) {
      $met[$_] = $met_self[$_] = 0;
      push @threads, threads->create(\&chameneos, $_);
   }
   for (@threads) {
     $_->join();
   }

   $meetings = 0;
   for (0 .. $#creatures) {
      print "\n$met[$_]", num2words($met_self[$_]);
      $meetings += $met[$_];
     }
   print "\n", num2words($meetings), "\n\n";
}


display_complements();
pall_mall($ARGV[0], qw(blue red yellow));
pall_mall($ARGV[0], qw(blue red yellow red yellow blue red yellow red blue));
    

NOTES:
64-bit Ubuntu quad core
This is perl 5, version 26, subversion 0 (v5.26.0) built for x86_64-linux-gnu-thread-multi



Thu, 16 Nov 2017 18:14:53 GMT

COMMAND LINE:
/usr/bin/perl chameneosredux.perl-4.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
3632187 zero
5016499 zero
3351314 zero
 one two zero zero zero zero zero zero

 blue red yellow red yellow blue red yellow red blue
1197800 zero
1203488 zero
1200743 zero
1201480 zero
1198949 zero
1198723 zero
1200023 zero
1199076 zero
1196457 zero
1203261 zero
 one two zero zero zero zero zero zero