[poe-commits] SF.net SVN: poe:[2527] trunk/queue

[<rc...@us...>]

Revision: 2527
          http://poe.svn.sourceforge.net/poe/?rev=2527&view=rev
Author:   rcaputo
Date:     2009-05-07 02:58:14 +0000 (Thu, 07 May 2009)

Log Message:
-----------
Modernize the data collection programs a bit.  Cant

Modified Paths:
--------------
    trunk/queue/benchmark-size.pl
    trunk/queue/benchmark.pl

Removed Paths:
-------------
    trunk/queue/POE/Queue/Array.pm

Deleted: trunk/queue/POE/Queue/Array.pm
===================================================================
--- trunk/queue/POE/Queue/Array.pm	2009-04-21 05:03:17 UTC (rev 2526)
+++ trunk/queue/POE/Queue/Array.pm	2009-05-07 02:58:14 UTC (rev 2527)
@@ -1,217 +0,0 @@
-# $Id$
-# Copyrights and documentation are at the end.
-
-package POE::Queue::Array;
-
-use strict;
-
-use vars qw(@ISA);
-@ISA = qw(POE::Queue);
-
-use constant PRIO  => 0;
-use constant VALUE => 1;
-
-sub LARGE_QUEUE_SIZE () { 512 }
-
-
-### Very simple constructor.
-
-sub new {
-  return bless [];
-}
-
-### Add a value to the queue.
-
-sub enqueue {
-  my ($self, $prio, $value) = @_;
-
-  my $event =
-    [ $prio,   # PRIO
-      $value,  # VALUE
-    ];
-
-  # Special case: No events in the queue.  Put the new event in the
-  # queue, and be done with it.
-
-  unless (@$self) {
-    $self->[0] = $event;
-    return;
-  }
-
-  # Special case: New event belongs at the end of the queue.  Push it,
-  # and be done with it.
-
-  if ($prio >= $self->[-1]->[PRIO]) {
-    push @$self, $event;
-    return;
-  }
-
-  # Special case: New event comes before earliest event.  Unshift it,
-  # and be done with it.
-
-  if ($prio < $self->[0]->[PRIO]) {
-    unshift @$self, $event;
-    return;
-  }
-
-  # Special case: Two events in the queue.  The new event enters
-  # between them, because it's not before the first one or after the
-  # last one.
-
-  if (@$self == 2) {
-    splice @$self, 1, 0, $event;
-    return;
-  }
-
-  # Small queue.  Perform a reverse linear search on the assumption
-  # that (a) a linear search is fast enough on small queues; and (b)
-  # most events will be posted for "now" or some future time, which
-  # tends to be towards the end of the queue.
-
-  if (@$self < LARGE_QUEUE_SIZE) {
-    my $index = @$self;
-    $index--
-      while ( $index and
-              $prio < $self->[$index-1]->[PRIO]
-            );
-    splice @$self, $index, 0, $event;
-    return;
-  }
-
-  # And finally, we have this large queue, and the program has already
-  # wasted enough time.  -><- It would be neat for POE to determine
-  # the break-even point between "large" and "small" event queues at
-  # start-up and tune itself accordingly.
-
-  my $upper = @$self - 1;
-  my $lower = 0;
-  while ('true') {
-    my $midpoint = ($upper + $lower) >> 1;
-
-    # Upper and lower bounds crossed.  No match; insert at the lower
-    # bound point.
-
-    if ($upper < $lower) {
-      splice @$self, $lower, 0, $event;
-      return;
-    }
-
-    # The key at the midpoint is too high.  The element just below the
-    # midpoint becomes the new upper bound.
-
-    if ($prio < $self->[$midpoint]->[PRIO]) {
-      $upper = $midpoint - 1;
-      next;
-    }
-
-    # The key at the midpoint is too low.  The element just above the
-    # midpoint becomes the new lower bound.
-
-    if ($prio > $self->[$midpoint]->[PRIO]) {
-      $lower = $midpoint + 1;
-      next;
-    }
-
-    # The key matches the one at the midpoint.  Scan towards higher
-    # keys until the midpoint points to an element with a higher key.
-    # Insert the new event before it.
-
-    $midpoint++
-      while ( ($midpoint < @$self)
-              and ($prio == $self->[$midpoint]->[PRIO])
-            );
-    splice @$self, $midpoint, 0, $event;
-    return;
-  }
-
-  die;
-}
-
-### Remove the next value from the queue.  The "next" value is the
-### oldest one with the lowest priority.
-
-sub dequeue {
-  my $self = shift;
-  return undef unless @$self;
-  return shift(@$self)->[VALUE];
-}
-
-### Remove everything in the queue that has a priority at or before a
-### specified one.
-
-sub dequeue_through {
-  my ($self, $prio) = @_;
-
-  my $search = 0;
-  $search++ while ($search < @$self and $self->[$search]->[PRIO] <= $prio);
-
-  return [ map { $_->[VALUE] } splice(@$self, 0, $search) ];
-}
-
-### Return the next priority in the queue, or undef if the queue is
-### empty.
-
-sub get_next_priority {
-  my $self = shift;
-  return undef unless @$self;
-  return $self->[0]->[PRIO];
-}
-
-### Remove everything from the queue that matches the next priority in
-### the queue.
-
-sub dequeue_next_priority {
-  my $self = shift;
-  return [] unless @$self;
-
-  my $prio = $self->[0]->[PRIO];
-  my $search = 0;
-  $search++ while ($search < @$self and $self->[$search]->[PRIO] <= $prio);
-
-  return [ map { $_->[VALUE] } splice(@$self, 0, $search) ];
-}
-
-### Remove things from the queue.  A coderef is supplied, and it will
-### be called for everything in the queue, and things that it matches
-### will be removed.
-
-sub remove_items {
-  my ($self, $cref) = @_;
-
-  my $i = @$self;
-  while ($i--) {
-    splice(@$self, $i, 1) unless $cref->($self->[$i]->[VALUE]);
-  }
-}
-
-1;
-
-__END__
-
-=head1 NAME
-
-POE::Queue::Array - an array implementation for POE::Queue
-
-=head1 SYNOPSIS
-
-To do.
-
-=head1 DESCRIPTION
-
-To do.
-
-=head1 SEE ALSO
-
-To do.
-
-=head1 BUGS
-
-To do.
-
-=head1 AUTHORS & COPYRIGHT
-
-POE::Queue::Array is contributed by Artur Bergman.
-
-Please see L<POE> for more information about authors and contributors.
-
-=cut

Modified: trunk/queue/benchmark-size.pl
===================================================================
--- trunk/queue/benchmark-size.pl	2009-04-21 05:03:17 UTC (rev 2526)
+++ trunk/queue/benchmark-size.pl	2009-05-07 02:58:14 UTC (rev 2527)
@@ -6,8 +6,14 @@
 $|=1;
 
 use lib ".";
-use POE::Queue;
 
+my $impl;
+BEGIN {
+  $impl = shift;
+  eval "use $impl";
+  die $@ if $@;
+}
+
 # The sequence length should be at least as many items as there are
 # priorities.
 
@@ -23,7 +29,8 @@
 
   @seq = map { [ $_, $_ ] } (0..($priorities-1));
 
-  { srand(1);
+  {
+    srand(1);
     my $i = @seq;
     while (--$i) {
       my $j = int rand($i+1);
@@ -39,71 +46,39 @@
 
   build_list($priorities);
 
-  # One for each queue implementation.
-  for my $impl (qw(Array PriorityHeap)) {
+  my $queue = $impl->new();
 
-    my $queue = POE::Queue->new($impl);
+  ### Plain enqueue/dequeue.
 
-    ### Plain enqueue/dequeue.
+  my ($begin_usr, $begin_sys) = (times)[0,1];
+  $queue->enqueue(@$_) for @seq;
+  my ($cease_usr, $cease_sys) = (times)[0,1];
 
-    my ($begin_usr, $begin_sys) = (times)[0,1];
-    $queue->enqueue(@$_) for @seq;
-    my ($cease_usr, $cease_sys) = (times)[0,1];
+  my $elapsed = ($cease_usr - $begin_usr) + ($cease_sys - $begin_sys);
 
-    my $elapsed = ($cease_usr - $begin_usr) + ($cease_sys - $begin_sys);
+  print(
+    join(
+      "\t",
+      $priorities,
+      $impl, "enqueue-plain",
+      $elapsed/$priorities, # Time per operation.
+    ),
+    "\n"
+  );
 
-    print( join( "\t",
-                 $priorities,
-                 $impl, "enqueue-plain",
-                 $elapsed/$priorities, # Time per operation.
-               ),
-           "\n"
-         );
+  ($begin_usr, $begin_sys) = (times)[0,1];
+  1 while $queue->dequeue_next();
+  ($cease_usr, $cease_sys) = (times)[0,1];
 
-    ($begin_usr, $begin_sys) = (times)[0,1];
-    1 while $queue->dequeue;
-    ($cease_usr, $cease_sys) = (times)[0,1];
+  $elapsed = ($cease_usr - $begin_usr) + ($cease_sys - $begin_sys);
 
-    $elapsed = ($cease_usr - $begin_usr) + ($cease_sys - $begin_sys);
-
-    print( join( "\t",
-                 $priorities,
-                 $impl, "dequeue-plain",
-                 $elapsed/$priorities, # Time per operation.
-               ),
-           "\n"
-         );
-
-    ### Next-priority enqueue/dequeue.  The enqueue is actually just a
-    ### plain one, but we get to see the effect of internal data
-    ### structure freeing tradeoffs.
-
-    ($begin_usr, $begin_sys) = (times)[0,1];
-    $queue->enqueue(@$_) for @seq;
-    ($cease_usr, $cease_sys) = (times)[0,1];
-
-    $elapsed = ($cease_usr - $begin_usr) + ($cease_sys - $begin_sys);
-
-    print( join( "\t",
-                 $priorities,
-                 $impl, "enqueue-np",
-                 $elapsed/$priorities, # Time per operation.
-               ),
-           "\n"
-         );
-
-    ($begin_usr, $begin_sys) = (times)[0,1];
-    1 while scalar(@{$queue->dequeue_next_priority});
-    ($cease_usr, $cease_sys) = (times)[0,1];
-
-    $elapsed = ($cease_usr - $begin_usr) + ($cease_sys - $begin_sys);
-
-    print( join( "\t",
-                 $priorities,
-                 $impl, "dequeue-np",
-                 $elapsed/$priorities, # Time per operation.
-               ),
-           "\n"
-         );
-  }
+  print(
+    join(
+      "\t",
+      $priorities,
+      $impl, "dequeue-plain",
+      $elapsed/$priorities, # Time per operation.
+    ),
+    "\n"
+  );
 }

Modified: trunk/queue/benchmark.pl
===================================================================
--- trunk/queue/benchmark.pl	2009-04-21 05:03:17 UTC (rev 2526)
+++ trunk/queue/benchmark.pl	2009-05-07 02:58:14 UTC (rev 2527)
@@ -5,8 +5,15 @@
 
 $|=1;
 
-use POE::Queue;
+use lib ".";
 
+my $impl;
+BEGIN {
+  $impl = shift;
+  eval "use $impl";
+  die $@ if $@;
+}
+
 # The sequence length should be at least as many items as there are
 # priorities.
 
@@ -26,7 +33,8 @@
 
   @seq = map { [ int($_ / $factor), $_ ] } (0..(SEQUENCE_LENGTH-1));
 
-  { srand(1);
+  {
+    srand(1);
     my $i = @seq;
     while (--$i) {
       my $j = int rand($i+1);
@@ -42,71 +50,39 @@
 
   build_list($priorities);
 
-  # One for each queue implementation.
-  for my $impl (qw(Array PriorityHeap)) {
+  my $queue = $impl->new();
 
-    my $queue = POE::Queue->new($impl);
+  ### Plain enqueue/dequeue.
 
-    ### Plain enqueue/dequeue.
+  my ($begin_usr, $begin_sys) = (times)[0,1];
+  $queue->enqueue(@$_) for @seq;
+  my ($cease_usr, $cease_sys) = (times)[0,1];
 
-    my ($begin_usr, $begin_sys) = (times)[0,1];
-    $queue->enqueue(@$_) for @seq;
-    my ($cease_usr, $cease_sys) = (times)[0,1];
+  my $elapsed = ($cease_usr - $begin_usr) + ($cease_sys - $begin_sys);
 
-    my $elapsed = ($cease_usr - $begin_usr) + ($cease_sys - $begin_sys);
+  print(
+    join(
+      "\t",
+      $priorities,
+      $impl, "enqueue-plain",
+      $elapsed/SEQUENCE_LENGTH, # Time per operation.
+    ),
+    "\n"
+  );
 
-    print( join( "\t",
-                 $priorities,
-                 $impl, "enqueue-plain",
-                 $elapsed/SEQUENCE_LENGTH, # Time per operation.
-               ),
-           "\n"
-         );
+  ($begin_usr, $begin_sys) = (times)[0,1];
+  1 while $queue->dequeue;
+  ($cease_usr, $cease_sys) = (times)[0,1];
 
-    ($begin_usr, $begin_sys) = (times)[0,1];
-    1 while $queue->dequeue;
-    ($cease_usr, $cease_sys) = (times)[0,1];
+  $elapsed = ($cease_usr - $begin_usr) + ($cease_sys - $begin_sys);
 
-    $elapsed = ($cease_usr - $begin_usr) + ($cease_sys - $begin_sys);
-
-    print( join( "\t",
-                 $priorities,
-                 $impl, "dequeue-plain",
-                 $elapsed/SEQUENCE_LENGTH, # Time per operation.
-               ),
-           "\n"
-         );
-
-    ### Next-priority enqueue/dequeue.  The enqueue is actually just a
-    ### plain one, but we get to see the effect of internal data
-    ### structure freeing tradeoffs.
-
-    ($begin_usr, $begin_sys) = (times)[0,1];
-    $queue->enqueue(@$_) for @seq;
-    ($cease_usr, $cease_sys) = (times)[0,1];
-
-    $elapsed = ($cease_usr - $begin_usr) + ($cease_sys - $begin_sys);
-
-    print( join( "\t",
-                 $priorities,
-                 $impl, "enqueue-np",
-                 $elapsed/SEQUENCE_LENGTH, # Time per operation.
-               ),
-           "\n"
-         );
-
-    ($begin_usr, $begin_sys) = (times)[0,1];
-    1 while scalar(@{$queue->dequeue_next_priority});
-    ($cease_usr, $cease_sys) = (times)[0,1];
-
-    $elapsed = ($cease_usr - $begin_usr) + ($cease_sys - $begin_sys);
-
-    print( join( "\t",
-                 $priorities,
-                 $impl, "dequeue-np",
-                 $elapsed/SEQUENCE_LENGTH, # Time per operation.
-               ),
-           "\n"
-         );
-  }
+  print(
+    join(
+      "\t",
+      $priorities,
+      $impl, "dequeue-plain",
+      $elapsed/SEQUENCE_LENGTH, # Time per operation.
+    ),
+    "\n"
+  );
 }


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.