File Coverage

blib/lib/Algorithm/NaiveBayes.pm

Criterion	Covered	Total	%
statement	54	54	100.0
branch	14	20	70.0
condition	2	5	40.0
subroutine	16	16	100.0
pod	9	11	81.8
total	95	106	89.6

package Algorithm::NaiveBayes;

use strict;
use Storable;

use vars qw($VERSION);
$VERSION = '0.04';

sub new {
  my $package = shift;
  my $self = bless {
	      version => $VERSION,
	      purge => 1,
	      model_type => 'Frequency',
	      @_,
	      instances => 0,
	      training_data => {},
	     }, $package;

  if ($package eq __PACKAGE__) {
    # Bless into the proper subclass
    return $self->_load_model_class->new(@_);
  }

  return bless $self, $package;
}

sub _load_model_class {
  my $self = shift;
  die "model_class cannot be set to " . __PACKAGE__ if ($self->{model_class}||'') eq __PACKAGE__;
  my $package = $self->{model_class} || __PACKAGE__ . "::Model::" . $self->{model_type};
  unless ($package->can('new')) {
    eval "use $package";
    die $@ if $@;
  }
  return $package;
}

sub save_state {
  my ($self, $path) = @_;
  Storable::nstore($self, $path);
}

sub restore_state {
  my ($pkg, $path) = @_;
  my $self = Storable::retrieve($path)
    or die "Can't restore state from $path: $!";
  $self->_load_model_class;
  return $self;
}

sub add_instance {
  my ($self, %params) = @_;
  for ('attributes', 'label') {
    die "Missing required '$_' parameter" unless exists $params{$_};
  }
  for ($params{label}) {
    $_ = [$_] unless ref;
    @{$self->{labels}}{@$_} = ();
  }

  $self->{instances}++;
  $self->do_add_instance($params{attributes}, $params{label}, $self->{training_data});
}

sub labels { keys %{ $_[0]->{labels} } }
sub instances  { $_[0]->{instances} }
sub training_data { $_[0]->{training_data} }

sub train {
  my $self = shift;
  $self->{model} = $self->do_train($self->{training_data});
  $self->do_purge if $self->purge;
}

sub do_purge {
  my $self = shift;
  delete $self->{training_data};
}

sub purge {
  my $self = shift;
  $self->{purge} = shift if @_;
  return $self->{purge};
}

sub predict {
  my ($self, %params) = @_;
  my $newattrs = $params{attributes} or die "Missing 'attributes' parameter for predict()";
  return $self->do_predict($self->{model}, $newattrs);
}

1;
__END__