File Coverage

blib/lib/Math/Random/Discrete.pm

Criterion	Covered	Total	%
statement	44	44	100.0
branch	9	12	75.0
condition	4	9	44.4
subroutine	5	5	100.0
pod	2	2	100.0
total	64	72	88.8

package Math::Random::Discrete;
$Math::Random::Discrete::VERSION = '1.02';
use strict;
use warnings;

use Carp qw(croak);

# ABSTRACT: Discrete random variables with general distributions

# This is an implementation of Walker's alias method.

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

    croak("No weights specified")
        if !defined($_weights) || !@$_weights;
    croak("Number of values must equal number of weights")
        if defined($values) && @$values != @$_weights;

    my @weights = @$_weights;

    # compute average weight

    my $N   = @weights;
    my $sum = 0;

    for my $weight (@weights) {
        $sum += $weight;
    }

    my $avg = $sum / $N;

    # split weights into two groups: smaller and larger than average

    my (@small, @large);

    for (my $i = 0; $i < $N; ++$i) {
        if ($weights[$i] <= $avg) {
            push(@small, $i);
        }
        else {
            push(@large, $i);
        }
    }

    # generate F and A arrays

    my (@F, @A);

    while (@small and @large) {
        my $i  = pop(@small);
        my $j  = $large[-1];
        $A[$i] = $j;
        $F[$i] = $weights[$i] / $avg;

        $weights[$j] -= $avg - $weights[$i];

        push(@small, pop(@large))
            if $weights[$j] <= $avg;
    }

    for my $i (@small, @large) {
        $A[$i] = $i;
        $F[$i] = 1.0;
    }

    # create blessed ref

    my $self = {
        values => $values,
        A      => \@A,
        F      => \@F,
    };

    return bless($self, $class);
}

sub rand {
    my $self = shift;

    my $F  = $self->{F};
    my $r  = CORE::rand(@$F);
    my $ri = int($r);  # integer part
    my $rf = $r - $ri; # fractional part

    my $i = $rf < $F->[$ri] ? $ri : $self->{A}[$ri];

    my $values = $self->{values};

    return $values ? $values->[$i] : $i;
}

1;

__END__