view release on metacpan or  search on metacpan

t/03-AM.t  view on Meta::CPAN

# Test correct classification.
# Mostly uses the example from chapter 3 of the green book

use strict;
use warnings;
use Algorithm::AM;
use Test::More 0.88;
plan tests => 14;
use Test::NoWarnings;
use Test::Exception;
use Test::Deep;
use t::TestAM qw(chapter_3_train chapter_3_test);

use FindBin qw($Bin);
use Path::Tiny;

test_input_checking();
test_accessors();


my $train = chapter_3_train();
my $test = chapter_3_test()->get_item(0);
my $result = Algorithm::AM->new(training_set => $train)->classify($test);

test_quadratic_classification($result);
test_analogical_set($result);
test_gang_effects($result);

test_linear_classification();
test_nulls();
test_given();

# test that methods die with bad input
sub test_input_checking {
    throws_ok {
        Algorithm::AM->new();
    } qr/Missing required parameter 'training_set'/,
    'dies when no training set provided';

    throws_ok {
        Algorithm::AM->new(
            training_set => 'stuff',
        );
    } qr/Parameter training_set should be an Algorithm::AM::DataSet/,
    'dies with bad training set';

    throws_ok {
        Algorithm::AM->new(
            training_set => Algorithm::AM::DataSet->new(
                cardinality => 3),
            foo => 'bar'
        );
    } qr/Invalid attributes for Algorithm::AM: foo/,
    'dies with bad argument';

    throws_ok {
        my $am = Algorithm::AM->new(
            training_set => Algorithm::AM::DataSet->new(cardinality => 3),
        );
        $am->classify(
            Algorithm::AM::DataSet::Item->new(
                features => ['a']
            )
        );
    } qr/Training set and test item do not have the same cardinality \(3 and 1\)/,
    'dies with mismatched train/test cardinalities';

    return;
}

# test that constructor sets state properly
sub test_accessors {
    subtest 'AM constructor saves data set' => sub {
        plan tests => 2;
        my $am = Algorithm::AM->new(
            training_set => Algorithm::AM::DataSet->new(cardinality => 3),
        );
        isa_ok($am->training_set, 'Algorithm::AM::DataSet',
            'training_set returns correct object type');

        is($am->training_set->cardinality, 3,
            'training set saved');
    };
}

# test classification results using quadratic counting
sub test_quadratic_classification {
    my ($result) = @_;
    subtest 'quadratic calculation' => sub {
        plan tests => 3;
        is($result->total_points, 13, 'total pointers')
            or note $result->total_points;
        is($result->count_method, 'squared',
            'counting configured to quadratic');
        is_deeply($result->scores, {'e' => 4, 'r' => 9},
            'class scores') or
            note explain $result->scores;
    };
    return;
}

# test classification results using linear counting
sub test_linear_classification {
    subtest 'linear calculation' => sub {
        plan tests => 3;
        my $am = Algorithm::AM->new(
            training_set => $train,
            linear => 1
        );
        my ($result) = $am->classify($test);
        is($result->total_points, 7, 'total pointers')
            or note $result->total_points;;
        is($result->count_method, 'linear',
            'counting configured to quadratic');
        is_deeply($result->scores, {'e' => 2, 'r' => 5}, 'class scores')
            or note explain $result->scores;