File Coverage

blib/lib/Algorithm/AM/Batch.pm

Criterion	Covered	Total	%
statement	110	131	83.9
branch	37	48	77.0
condition	14	21	66.6
subroutine	17	18	94.4
pod	2	3	66.6
total	180	221	81.4

package Algorithm::AM::Batch;
use strict;
use warnings;
our $VERSION = '3.12';
# ABSTRACT: Classify items in batch mode
use feature 'state';
use Carp;
use Log::Any qw($log);
our @CARP_NOT = qw(Algorithm::AM::Batch);

# Place this accessor here so that Class::Tiny doesn't generate
# a getter/setter pair.
sub test_set {
    my ($self) = @_;
    return $self->{test_set};
}

use Class::Tiny qw(
    training_set

    exclude_nulls
    exclude_given
    linear
    probability
    repeat
    max_training_items

    begin_hook
    begin_test_hook
    begin_repeat_hook
    training_item_hook
    end_repeat_hook
    end_test_hook
    end_hook

    test_set
), {
    exclude_nulls     => 1,
    exclude_given    => 1,
    linear      => 0,
    probability => 1,
    repeat      => 1,
};

use Algorithm::AM;
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;
}

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(!(ref $args) || !$args->{training_set}->isa(
            'Algorithm::AM::DataSet')){
        croak 'Parameter training_set should be an ' .
            'Algorithm::AM::DataSet';
    }
    for(qw(
        begin_hook
        begin_test_hook
        begin_repeat_hook
        training_item_hook
        end_repeat_hook
        end_test_hook
        end_hook
    )){
        if(exists $args->{$_} and 'CODE' ne ref $args->{$_}){
            croak "Input $_ should be a subroutine";
        }
    }

    return;
}

sub classify_all {
    my ($self, $test_set) = @_;

    if(!$test_set || 'Algorithm::AM::DataSet' ne ref $test_set){
        croak q[Must provide a DataSet to classify_all];
    }
    if($self->training_set->cardinality != $test_set->cardinality){
        croak 'Training and test sets do not have the same ' .
            'cardinality (' . $self->training_set->cardinality .
                ' and ' . $test_set->cardinality . ')';
    }
    $self->_set_test_set($test_set);

    if($self->begin_hook){
        $self->begin_hook->($self);
    }

    # save the result objects from all items, all iterations, here
    my @all_results;

    foreach my $item_number (0 .. $test_set->size - 1) {
        if($log->is_debug){
            $log->debug('Test items left: ' .
                $test_set->size + 1 - $item_number);
        }
        my $test_item = $test_set->get_item($item_number);
        # store the results just for this item
        my @item_results;

        if($self->begin_test_hook){
            $self->begin_test_hook->($self, $test_item);
        }

        if($log->is_debug){
            my ( $sec, $min, $hour ) = localtime();
            $log->info(
                sprintf( "Time: %2s:%02s:%02s\n", $hour, $min, $sec) .
                $test_item->comment . "\n" .
                sprintf( "0/$self->{repeat}  %2s:%02s:%02s",
                    $hour, $min, $sec ) );
        }

        my $iteration = 1;
        while ( $iteration <= $self->repeat ) {
            if($self->begin_repeat_hook){
                $self->begin_repeat_hook->(
                    $self, $test_item, $iteration);
            }

            # this sets excluded_items
            my ($training_set, $excluded_items) = $self->_make_training_set(
                $test_item, $iteration);

            # classify the item with the given training set and
            # configuration
            my $am = Algorithm::AM->new(
                training_set => $training_set,
                exclude_nulls => $self->exclude_nulls,
                exclude_given => $self->exclude_given,
                linear => $self->linear,
            );
            my $result = $am->classify($test_item);

            _log_result($result)
                if($log->is_info);

            if($log->is_info){
                my ( $sec, $min, $hour ) = localtime();
                $log->info(
                    sprintf(
                        $iteration . '/' . $self->repeat .
                        '  %2s:%02s:%02s',
                        $hour, $min, $sec
                    )
                );
            }

            if($self->end_repeat_hook){
                # pass in self, test item, data, and result
                $self->end_repeat_hook->($self, $test_item,
                    $iteration, $excluded_items, $result);
            }
            push @item_results, $result;
            $iteration++;
        }

        if($self->end_test_hook){
            $self->end_test_hook->($self, $test_item, @item_results);
        }

        push @all_results, @item_results;
    }

    if($log->is_info){
        my ( $sec, $min, $hour ) = localtime();
        $log->info(
            sprintf( "Time: %2s:%02s:%02s", $hour, $min, $sec ) );
    }

    if($self->end_hook){
        $self->end_hook->($self, @all_results);
    }
    $self->_set_test_set(undef);
    return @all_results;
}

# log the summary printouts from the input result object
sub _log_result {
    my ($result) = @_;

    $log->info(${$result->statistical_summary});

    $log->info(${$result->analogical_set_summary()});

    if($log->is_debug){
        $log->debug(${ $result->gang_summary(1) });
    }elsif($log->is_info){
        $log->info(${ $result->gang_summary(0) })
    }
    return;
}

# create the training set for this iteration, calling training_item_hook and
# updating excluded_items along the way
sub _make_training_set {
    my ($self, $test_item, $iteration) = @_;
    my $training_set;

    # $self->_set_excluded_items([]);
    my @excluded_items;
    # Cap the amount of considered data if specified
    my $max = defined $self->max_training_items ?
        int($self->max_training_items) :
        $self->training_set->size;

    # use the original DataSet object if there are no settings
    # that would trim items from it
    if(!$self->training_item_hook &&
            ($self->probability == 1) &&
            $max >= $self->training_set->size){
        $training_set = $self->training_set;
    }else{
        # otherwise, make a new set with just the selected
        # items
        $training_set = Algorithm::AM::DataSet->new(
            cardinality => $self->training_set->cardinality);

        # don't try to add more items than we have!
        my $num_items = ($max > $self->training_set->size) ?
            $self->training_set->size :
            $max;
        for my $data_index ( 0 .. $num_items - 1 ) {
            my $training_item =
                $self->training_set->get_item($data_index);
            # skip this data item if the training_item_hook returns false
            if($self->training_item_hook &&
                    !$self->training_item_hook->($self,
                        $test_item, $iteration, $training_item)
                    ){
                push @excluded_items, $training_item;
                next;
            }
            # skip this data item with probability $self->{probability}
            if($self->probability != 1 &&
                    rand() > $self->probability){
                push @excluded_items, $training_item;
                next;
            }
            $training_set->add_item($training_item);
        }
    }
    # $self->_set_excluded_items(\@excluded_items);
    return ($training_set, \@excluded_items);
}

sub _set_test_set {
    my ($self, $test_set) = @_;
    $self->{test_set} = $test_set;
    return;
}

1;

__END__