Re^10: Re-orderable keyed access structure?

[BrowserUk]

I wanted to see if how heaps could be made to work for this.

As well as O(N) -v- O(log N) for any given part of an algorithm not telling the whole story, you also have to consider the cost of all parts of the algorithm.

This benchmarks not only the promotion, but also building the list, promoting from any given position and removing (lowest weighted) items, until empty.

Feel free to show me where I am using a bad implementation.

#! perl -slw
use strict;
use List::Util;
use Benchmark qw[ cmpthese ];

our $SIZE ||= 1000;
our $ITERS||= -5;

sub spliceIt{
    my @a;
    ## Add $SIZE items
    push @a, $_ for 0 .. $SIZE;

    ## Promote $SIZE items, 1 from each position.
    push @a, splice @a, $_, 1 for 1 .. $SIZE;

    ## Remove $SIZE (lowest) items.
    shift @a for 0 .. $SIZE;
}

sub heapIt {
    my @a;
    ## Add $SIZE items
    for( 0 .. $SIZE ) {
        $a[ @a ] = ( $a[ 0 ] || 0 ) + 1;
        moveUp( \@a, $#a );
    }

    ## Promote $SIZE items, 1 from each position.
    ## !!Ass-uming I could locate the item that needs promoting!!
    for( 0 .. $SIZE ) {
        $a[ $_ ] = $a[ 0 ] + 1;
        moveUp( \@a, $_ );
    }

    ## Remove $SIZE (lowest) items.
    for( 0 .. $SIZE ) {
        ## Find the lowest (linear search unless you know a better way
+?)
        my $low = 0;
        for( 1 .. $#a ) {
            $a[ $_ ] < $a[ $low ] and $low = $_;
        }
        ## If the lowest is the last
        ## remove and and move on.
        $#a-- and next if $low == $#a;
        ## overwrite the lowest with the highest
        $a[ $low ] = $a[ 0 ];
        ## Move the last to the highest
        $a[ 0 ] = $a[ $#a ];
        ## Discard the last 
        $#a--;
        ## Now move the (moved) highest item up
        moveUp( \@a, $low );
    }
}

sub moveUp {
    my( $ref, $l ) = @_;
    my $p = int $l /2;
    return if $p >= $l;
    my $temp = $ref->[ $p ];
    $ref->[ $p ] = $ref->[ $l ];
    $ref->[ $l ] = $temp;
    moveUp( $ref, $p );
}

print "Testing $SIZE items for $ITERS iterations";

cmpthese( $ITERS, {
    splice => \&spliceIt,
    heap   => \&heapIt,
});
__END__
## After making the benchmark more realistic 
## By benchmarking adding, promoting & removing (lowest) items.
P:\test>heaptest -ITERS=-5 -SIZE=100
Testing 100 items for -5 iterations
         Rate   heap splice
heap    156/s     --   -98%
splice 8335/s  5235%     --

P:\test>heaptest -ITERS=-5 -SIZE=100
Testing 100 items for -5 iterations
         Rate   heap splice
heap    157/s     --   -98%
splice 8330/s  5221%     --

P:\test>heaptest -ITERS=-5 -SIZE=1000
Testing 1000 items for -5 iterations
         Rate   heap splice
heap   4.21/s     --   -99%
splice  662/s 15613%     --

P:\test>heaptest -ITERS=-5 -SIZE=10000
Testing 10000 items for -5 iterations
            (warning: too few iterations for a reliable count)

          s/iter   heap splice
heap        17.9     --  -100%
splice 5.18e-002 34393%     --