File Coverage

blib/lib/Statistics/TopK.pm

Criterion	Covered	Total	%
statement	49	51	96.0
branch	7	8	87.5
condition	2	6	33.3
subroutine	11	12	91.6
pod	4	4	100.0
total	73	81	90.1

package Statistics::TopK;

use strict;
use warnings;

use Carp qw(croak);

our $VERSION = '0.01';
$VERSION = eval $VERSION;

use constant _K      => 0;
use constant _COUNTS => 1;
use constant _ELEMS  => 2;
use constant _SIZE   => 3;
use constant _INDEX  => 4;

sub new {
    my ($class, $k) = @_;

    croak 'expecting a positive integer'
        unless defined $k and $k =~ /^\d+$/ and $k > 0;

    my $self = [
        $k,  # _K
        {},  # _COUNTS
        [],  # _ELEMS
        0,   # _SIZE
        0,   # _INDEX
    ];

    # Pre-extend the internal data structures, just in case $k is large.
    keys %{ $self->[_COUNTS] } = $k;
    $#{ $self->[_ELEMS] } = $k - 1;

    return bless $self, $class;
}

sub add {
    my ($self, $elem) = @_;

    # Increment the element's counter if it is currently being counted.
    if (exists $self->[_COUNTS]{$elem}) {
        return $self->[_COUNTS]{$elem} += 1;
    }

    # Add the element if it's not being counted and there are free slots.
    if ($self->[_SIZE] < $self->[_K]) {
        $self->[_ELEMS][ $self->[_SIZE]++ ] = $elem;
        return $self->[_COUNTS]{$elem} = 1;
    }

    # Decrement one of the currently counted elements.
    my $index = $self->[_INDEX];
    my $prev  = $self->[_ELEMS][$index];
    my $count = $self->[_COUNTS]{$prev} -= 1;

    # Advance the counter.
    $self->[_INDEX] = ++$self->[_INDEX] % $self->[_K];

    # If the count of the decremented element reaches 0, replace it with the
    # current element.
    if (0 == $count) {
        delete $self->[_COUNTS]{$prev};

        $self->[_ELEMS][$index] = $elem;

        return $self->[_COUNTS]{$elem} = 1;
    }

    # This element is not currently being counted.
    return 0;
}

sub top {
    return keys %{$_[0]->[_COUNTS]};
}

sub counts {
    return %{$_->[0]->[_COUNTS]};
}


1;

__END__