Beefy Boxes and Bandwidth Generously Provided by pair Networks
Think about Loose Coupling
 
PerlMonks  

Re: Heap sorting in perl

by Anonymous Monk
on Apr 05, 2003 at 15:29 UTC ( #248300=note: print w/replies, xml ) Need Help??


in reply to Heap sorting in perl

Rolling your own can be educational. I did it because I thought that it would be trivial to do. By the time I finished..well I was educated. ;-)

Note that I used the quicksort rather than heapsort because I assumed that the issue is memory usage, and quicksort is easier to do.

#! /usr/bin/perl use strict; # Demo usage here my $sorter = Sort::Limited->new( comp => sub { $_[0] cmp $_[1] }, limit => 20, ); for (1..100) { $sorter->add($_); } print join "|", $sorter->extract(); # The silly module - not well tested, etc. package Sort::Limited; use Data::Dumper; use Carp; sub add { my $self = shift; ELEM: foreach my $elem (@_) { my $node = $self->{data}; my $pos = 0; while (exists $node->{elem}) { # Traverse one level more if ($self->{comp}->($elem, $node->{elem}) < 0) { $node->{cnt}++; $node = $node->{left}; } else { $pos += 1 + $node->{cnt}; if ($self->{limit} < $pos) { # Filter data - we are past our limit $node->{right} = { cnt=>0 }; next ELEM; } $node = $node->{right}; } } # Fill in this node $node->{elem} = $elem; $node->{left} = { cnt=>0 }; $node->{right} = { cnt=>0 }; # And check whether to replace the root node... if ($self->{limit} < $self->{data}{cnt}) { $self->{data} = $self->{data}{left}; } } } sub extract { my $self = shift; my @results = _extract($self->{data}); my $last = @results < $self->{limit} ? @results : $self->{limit} - 1 +; return @results[0..$last]; } sub _extract { my $node = shift; if (exists $node->{elem}) { return ( _extract($node->{left}), $node->{elem}, _extract($node->{right}), ); } else { return (); } } sub new { my ($class, %args) = @_; my $self = {}; $self->{comp} = delete $args{comp} || sub {$_[0] cmp $_[1]}; $self->{limit} = delete $args{limit} || 10; if (%args) { $Data::Dumper::Indent = 1; confess ("Unprocessed arguments: ", Dumper(\%args)); } $self->{data} = { cnt => 0, }; return bless $self, $class; }

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://248300]
help
Chatterbox?
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others chanting in the Monastery: (10)
As of 2017-10-23 16:28 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    My fridge is mostly full of:

















    Results (281 votes). Check out past polls.

    Notices?