Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl: the Markov chain saw
 
PerlMonks  

Re^10: Re-orderable keyed access structure?

by BrowserUk (Pope)
on Aug 16, 2004 at 05:00 UTC ( #383195=note: print w/replies, xml ) Need Help??


in reply to Re^9: Re-orderable keyed access structure?
in thread Re-orderable keyed access structure?

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% --

Examine what is said, not who speaks.
"Efficiency is intelligent laziness." -David Dunham
"Think for yourself!" - Abigail
"Memory, processor, disk in that order on the hardware side. Algorithm, algorithm, algorithm on the code side." - tachyon

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://383195]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others romping around the Monastery: (7)
As of 2020-03-30 10:37 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    To "Disagree to disagree" means to:









    Results (175 votes). Check out past polls.

    Notices?