File Coverage

blib/lib/Statistics/Benford.pm

Criterion	Covered	Total	%
statement	62	62	100.0
branch	15	20	75.0
condition	4	4	100.0
subroutine	11	11	100.0
pod	4	4	100.0
total	96	101	95.0

package Statistics::Benford;

use strict;
use warnings;
use List::Util qw(sum);

our $VERSION = '0.08';
$VERSION = eval $VERSION;

use constant _BASE => 0;
use constant _N    => 1;
use constant _LEN  => 2;
use constant _DIST => 3;

sub new {
    my ($class, $base, $n, $len) = @_;

    $base ||= 10;
    $n = 0 unless defined $n;
    $len ||= 1;

    my ($k_start, $k_end, $d_start);
    if (0 == $n) {
        ($k_start, $k_end) = (0, 0);
        $d_start = $base ** ($len - 1);
    }
    else {
        ($k_start, $k_end) = ($base ** ($n - 1), $base ** $n - 1);
        $d_start = (1 == $len) ? 0 : $base ** ($len - 1);
    }
    my $d_end = $base ** $len - 1;

    my %dist;
    for my $digit ($d_start .. $d_end) {
        my $sum = 0;
        for my $k ($k_start .. $k_end) {
            $sum += log(1 + 1 / ($k * $base + $digit));
        }
        $dist{$digit} = (1 / log($base)) * $sum;
    }

    return bless [$base, $n, $len, \%dist], $class;
}

sub distribution {
    return %{ $_[0]->[_DIST] };
}

*dist = \&distribution;

sub difference {
    my ($self, %freq) = @_;
    my ($diff, %diff) = 0;

    my $count = sum values %freq;
    return 0 unless $count;

    while (my ($num, $percent) = each %{ $self->[_DIST] }) {
        my $delta = ($freq{$num} ? $freq{$num} / $count : 0) - $percent;
        $diff += abs($diff{$num} = $delta);
    }

    return wantarray ? %diff : $diff;
}

*diff = \&difference;

sub signif {
    my ($self, %freq) = @_;
    my ($diff, %diff) = 0;

    my $count = sum values %freq;
    return 0 unless $count;

    while (my ($num, $percent) = each %{ $self->[_DIST] }) {
        my $delta = ($freq{$num} ? $freq{$num} / $count : 0) - $percent;
        my $fix = abs $delta > (1 / (2 * $count)) ? (1 / (2 * $count)) : 0;
        my $z = (abs($delta) - $fix) /
                sqrt($percent * (1 - $percent) / $count);
        $diff += $diff{ $num } = $z ;
    }

    return wantarray ? %diff : $diff / keys %{ $self->[_DIST] };
}

*z = \&signif;

1;

__END__