File Coverage

blib/lib/AI/MaxEntropy/Util.pm

Criterion	Covered	Total	%
statement	45	45	100.0
branch	9	10	90.0
condition	2	2	100.0
subroutine	11	11	100.0
pod	5	5	100.0
total	72	73	98.6

use strict;
use warnings;

package AI::MaxEntropy::Util;

use Exporter;

our $VERSION = '0.20';

our @ISA = qw/Exporter/;

our @EXPORT_OK =
    qw/traverse_partially map_partially train_and_test precision recall/;

our %EXPORT_TAGS =
    (all => [@EXPORT_OK]);

sub traverse_partially(&$$;$) {
    my ($code, $samples, $pattern, $t) = @_;
    $t ||= 'x';
    my ($p, $n) = (length($pattern), scalar(@$samples));
    for my $i (grep { substr($pattern, $_, 1) eq $t } (0 .. $p - 1)) {
        for (int($n * $i / $p) .. int($n * ($i + 1) / $p) - 1) {
	    $_ = $samples->[$_];
	    $code->();
	}
    }
}

sub map_partially(&$$;$) {
    my ($code, $samples, $pattern, $t) = @_;
    my @r;
    traverse_partially { push @r, $code->($_) } $samples, $pattern, $t;
    return \@r;
}

sub train_and_test {
    my ($me, $samples, $pattern) = @_;
    traverse_partially { $me->see(@$_) } $samples, $pattern, 'x';
    my $m = $me->learn;
    my $r = map_partially { [$_ => $m->predict($_->[0])] }
        $samples, $pattern, 'o';
    return ($r, $m);
}

sub precision {
    my $r = shift;
    my ($c, $n) = (0, 0);
    for (@$r) {
        my $w = defined($_->[0]->[2]) ? $_->[0]->[2] : 1;
        $n += $w;
        $c += $w if $_->[0]->[1] eq $_->[1];
    }
    return $c / $n;
}

sub recall {
    my $r = shift;
    my $label = shift;
    my ($c, $n) = (0, 0);
    for (@$r) {
        if ($_->[0]->[1] eq $label) {
            my $w = defined($_->[0]->[2]) ? $_->[0]->[2] : 1;
	    $n += $w;
	    $c += $w if $_->[1] eq $label;
	}
    }
    return $c / $n;
}

1;

__END__