File Coverage

blib/lib/Algorithm/Numerical/Sample.pm

Criterion	Covered	Total	%
statement	18	61	29.5
branch	0	20	0.0
condition	0	3	0.0
subroutine	6	10	60.0
pod	1	1	100.0
total	25	95	26.3

package Algorithm::Numerical::Sample;

use 5.006;

use strict;
use warnings;
no  warnings 'syntax';
use Exporter ();

our @ISA       = qw /Exporter/;
our @EXPORT    = qw //;
our @EXPORT_OK = qw /sample/;

our $VERSION   = '2010011201';

my @PARAMS = qw /set sample_size/;
sub sample {
    my %args = @_;

    # Deal with - parameters.
    foreach (@PARAMS) {
        $args {$_} = $args {"-$_"} unless defined $args {$_};
    }

    # Check for set parameter.
    die "sample requires the set parameter" unless $args {set};

    my $set = $args {set};

    # Set sample and set size.
    my $sample_size = defined $args {sample_size} ? $args {sample_size} : 1;
    my $set_size    = @$set;

    # Reservoir will be our sample.
    my @reservoir      = (undef) x $sample_size;

    # Initialize counters.
    my $sample_counter = 0;
    my $set_counter    = 0;

    # Loop as long as the reservoir isn't filled.
    while ($sample_counter < $sample_size) {
        # Draw a random number.
        my $U = rand ($set_size - $set_counter);
        if ($U < $sample_size - $sample_counter) {
            # Select the next element with probability
            #    $sample_size - $sample_counter
            #    ------------------------------
            #    $set_size    - $set_counter
            $reservoir [$sample_counter ++] = $set -> [$set_counter];
        }
        $set_counter ++;
    }

    wantarray ? @reservoir : \@reservoir;
}



package Algorithm::Numerical::Sample::Stream;

use strict;


sub new {
    my $proto = shift;
    my $class = ref $proto || $proto;
    my %args  = @_;

    foreach (qw /sample_size/) {
        $args {$_} = $args {"-$_"} unless defined $args {$_};
    }

    my $self  = {};

    $self -> {sample_size} = defined $args {sample_size} ? $args {sample_size}
                                                         : 1;
    $self -> {seen}      = 0;
    $self -> {reservoir} = [(undef) x $self -> {sample_size}];

    bless $self, $class;
}

sub data {
    my $self   = shift;

    foreach my $sample (@_) {
        if ($self -> {seen} < $self -> {sample_size}) {
            # Initialize reservoir.
            $self -> {reservoir} -> [$self -> {seen}] =
                                    [$self -> {seen}, $sample];
        }
        else {
            # Draw number.
            my $U = int rand ($self -> {seen} + 1);
            if ($U < $self -> {sample_size}) {
                $self -> {reservoir} -> [$U] = [$self -> {seen}, $sample];
            }
        }

        $self -> {seen} ++;
    }

    return;
}

sub extract {
    my $self = shift;

    my @result = map {$_ -> [1]}
                 sort {$a -> [0] <=> $b -> [0]} @{$self -> {reservoir}};

    $self -> {seen}      = 0;
    $self -> {reservoir} = [(undef) x $self -> {sample_size}];

    wantarray ? @result : $result [0];
}


__END__