view release on metacpan or  search on metacpan

lib/AI/MaxEntropy/Model.pm  view on Meta::CPAN

use strict;
use warnings;

package AI::MaxEntropy::Model;

use YAML::Syck;

our $VERSION = '0.20';

sub new {
    my ($class, $model) = @_;
    my $self = bless {}, $class;
    $self->load($model) if defined($model);
    return $self;
}

sub load {
    my ($self, $file) = @_;
    my $model = LoadFile($file);
    ($self->{x_list}, $self->{y_list}, $self->{f_map}, $self->{lambda})
        = @$model;
    $self->{x_num} = scalar(@{$self->{x_list}});
    $self->{y_num} = scalar(@{$self->{y_list}});
    $self->{f_num} = scalar(@{$self->{lambda}});
    $self->{x_bucket}->{$self->{x_list}->[$_]} = $_
        for (0 .. $self->{x_num} - 1);
    $self->{y_bucket}->{$self->{y_list}->[$_]} = $_
        for (0 .. $self->{y_num} - 1);
}

sub save {
    my ($self, $file) = @_;
    my $data = [
        $self->{x_list},
	$self->{y_list},
	$self->{f_map},
	$self->{lambda}
    ];
    DumpFile($file, $data);    
}

sub all_x { @{$_[0]->{x_list}} }
sub all_labels { @{$_[0]->{y_list}} }

sub score {
    my $self = shift;
    my ($x, $y) = @_;
    # preprocess if $x is hashref
    $x = [
        map {
	    my $attr = $_;
	    ref($x->{$attr}) eq 'ARRAY' ? 
	        map { "$attr:$_" } @{$x->{$attr}} : "$_:$x->{$_}" 
        } keys %$x
    ] if ref($x) eq 'HASH';
    # calculate score
    my @x1 = map { $self->{x_bucket}->{$_} } @$x;
    my $lambda_f = 0;
    if (defined(my $y1 = $self->{y_bucket}->{$y})) {
        for my $x1 (@x1) {
	    if (defined($x1)) {
	        my $lambda_i = $self->{f_map}->[$y1]->[$x1];
                $lambda_f += $self->{lambda}->[$lambda_i]
		    if $lambda_i != -1;
            }
        }
    }
    return $lambda_f; 
}

sub predict {
    my $self = shift;
    my $x = shift;
    my @score = map { $self->score($x => $_) } @{$self->{y_list}};
    my ($max_score, $max_y) = (undef, undef);
    for my $y (0 .. $self->{y_num} - 1) {
        ($max_score, $max_y) = ($score[$y], $y) if not defined($max_y);
	($max_score, $max_y) = ($score[$y], $y) if $score[$y] > $max_score;
    }
    return $self->{y_list}->[$max_y];
}

1;

__END__

=head1 NAME

AI::MaxEntropy::Model - Perl extension for using Maximum Entropy Models

=head1 SYNOPSIS

  use AI::MaxEntropy::Model;

  # learn a model by AI::MaxEntropy
  require AI::MaxEntropy;
  my $me = AI::MaxEntropy->new;
  $me->see(['round', 'smooth', 'red'] => 'apple' => 2);
  $me->see(['long', 'smooth', 'yellow'] => 'banana' => 3);
  $me->see(['round', 'rough'] => 'orange' => 2);
  my $model = $me->learn;

  # make prediction on unseen data
  # ask what a red round thing is most likely to be
  my $y = $model->predict(['round', 'red']);
  # the answer apple is expected

  # print out scores of all possible labels