view release on metacpan or  search on metacpan

lib/Algorithm/AM.pm  view on Meta::CPAN

    training_set
), {
    exclude_nulls     => 1,
    exclude_given    => 1,
    linear      => 0,
};

sub BUILD {
    my ($self, $args) = @_;

    # check for invalid arguments
    my $class = ref $self;
    my %valid_attrs = map {$_ => 1}
        Class::Tiny->get_all_attributes_for($class);
    my @invalids = grep {!$valid_attrs{$_}} sort keys %$args;
    if(@invalids){
        croak "Invalid attributes for $class: " . join ' ',
            sort @invalids;
    }

    if(!exists $args->{training_set}){
        croak "Missing required parameter 'training_set'";
    }

    if('Algorithm::AM::DataSet' ne ref $args->{training_set}){
        croak 'Parameter training_set should ' .
            'be an Algorithm::AM::DataSet';
    }
    $self->_initialize();
    # delete $args->{training_set};
    return;
}

use Algorithm::AM::Result;
use Algorithm::AM::BigInt 'bigcmp';
use Algorithm::AM::DataSet;
use Import::Into;
# Use Import::Into to export classes into caller
sub import {
    my $target = caller;
    Algorithm::AM::BigInt->import::into($target, 'bigcmp');
    Algorithm::AM::DataSet->import::into($target, 'dataset_from_file');
    Algorithm::AM::DataSet::Item->import::into($target, 'new_item');
    return;
}

require XSLoader;
XSLoader::load(__PACKAGE__, $VERSION);

use Log::Any qw($log);

# do all of the classification data structure initialization here,
# as well as calling the XS initialization method.
sub _initialize {
    my ($self) = @_;

    my $train = $self->training_set;

    # compute sub-lattices sizes here so that lattice space can be
    # allocated in the _xs_initialize method. If certain features are
    # thrown out later, each sub-lattice can only get smaller, so
    # this is safe to do once here.
    my $lattice_sizes = _compute_lattice_sizes($train->cardinality);

    # sum is intitialized to a list of zeros
    @{$self->{sum}} = (0.0) x ($train->num_classes + 1);

    # preemptively allocate memory
    # TODO: not sure what this does
    @{$self->{itemcontextchain}} = (0) x $train->size;

    $self->{$_} = {} for (
        qw(
            itemcontextchainhead
            context_to_class
            context_size
            pointers
            raw_gang
        )
    );

    # Initialize XS data structures
    # TODO: Perl crashes unless this is saved. The XS
    # must not be increasing the reference count
    $self->{save_this} = $train->_data_classes;
    $self->_xs_initialize(
        $lattice_sizes,
        $self->{save_this},
        $self->{itemcontextchain},
        $self->{itemcontextchainhead},
        $self->{context_to_class},
        $self->{context_size},
        $self->{pointers},
        $self->{raw_gang},
        $self->{sum}
    );
    return;
}

sub classify {
    my ($self, $test_item) = @_;

    my $training_set = $self->training_set;
    if($training_set->cardinality != $test_item->cardinality){
        croak 'Training set and test item do not have the same ' .
            'cardinality (' . $training_set->cardinality . ' and ' .
                $test_item->cardinality . ')';
    }

    # num_feats is the number of features to be used in classification;
    # if we exclude nulls, then we need to minus the number of '='
    # found in this test item; otherwise, it's just the number of
    # columns in a single item vector
    my $num_feats = $training_set->cardinality;

    if($self->exclude_nulls){
        $num_feats -= grep {$_ eq ''} @{
            $test_item->features };
    }

    # recalculate the lattice sizes with new number of active features