#! /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; }