plan
tests
=> 12;
use
t::TestAM
qw(chapter_3_train chapter_3_test)
;
test_input_checking();
test_accessors();
test_classify();
sub
test_input_checking {
throws_ok {
Algorithm::AM::Batch->new();
}
qr/Missing required parameter 'training_set'/
,
'dies when no training set provided'
;
throws_ok {
Algorithm::AM::Batch->new(
training_set
=>
'stuff'
,
);
}
qr/Parameter training_set should be an Algorithm::AM::DataSet/
,
'dies with bad training set'
;
throws_ok {
Algorithm::AM::Batch->new(
training_set
=> Algorithm::AM::DataSet->new(
cardinality
=> 3),
test_set
=> Algorithm::AM::DataSet->new(
cardinality
=> 3),
foo
=>
'bar'
);
}
qr/Invalid attributes for Algorithm::AM::Batch/
,
'dies with bad argument'
;
throws_ok {
my
$batch
= Algorithm::AM::Batch->new(
training_set
=> Algorithm::AM::DataSet->new(
cardinality
=> 3)
);
$batch
->classify_all(Algorithm::AM::DataSet->new(
cardinality
=> 4));
}
qr/Training and test sets do not have the same cardinality \(3 and 4\)/
,
'dies with mismatched dataset cardinalities'
;
throws_ok {
my
$batch
= Algorithm::AM::Batch->new(
training_set
=>
Algorithm::AM::DataSet->new(
cardinality
=> 3)
);
$batch
->classify_all();
}
qr/Must provide a DataSet to classify_all/
,
'dies with no input to classify'
;
throws_ok {
my
$batch
= Algorithm::AM::Batch->new(
training_set
=> Algorithm::AM::DataSet->new(
cardinality
=> 3),
);
$batch
->classify_all(
'foo'
);
}
qr/Must provide a DataSet to classify_all/
,
'dies with bad test set'
;
return
;
}
sub
test_accessors {
subtest
'Constructor saves data sets'
=>
sub
{
plan
tests
=> 4;
my
$batch
= Algorithm::AM::Batch->new(
training_set
=> Algorithm::AM::DataSet->new(
cardinality
=> 3),
test_set
=> Algorithm::AM::DataSet->new(
cardinality
=> 3),
);
isa_ok(
$batch
->training_set,
'Algorithm::AM::DataSet'
,
'training_set returns correct object type'
);
isa_ok(
$batch
->test_set,
'Algorithm::AM::DataSet'
,
'test_set returns correct object type'
);
is(
$batch
->training_set->cardinality, 3,
'training set saved'
);
is(
$batch
->test_set->cardinality, 3,
'test set saved'
);
};
subtest
'default configuration'
=>
sub
{
plan
tests
=> 5;
my
$batch
= Algorithm::AM::Batch->new(
training_set
=> Algorithm::AM::DataSet->new(
cardinality
=> 3),
test_set
=> Algorithm::AM::DataSet->new(
cardinality
=> 3),
);
ok(
$batch
->exclude_nulls,
'exclude nulls by default'
);
ok(
$batch
->exclude_given,
'exclude given by default'
);
ok(!
$batch
->linear,
'pointer counting is quadratic by default'
);
is(
$batch
->probability, 1,
'probability is 1 by default'
);
is(
$batch
->repeat, 1,
'repeat is 1 by default'
);
};
subtest
'configuration via constructor'
=>
sub
{
plan
tests
=> 5;
my
$batch
= Algorithm::AM::Batch->new(
training_set
=> Algorithm::AM::DataSet->new(
cardinality
=> 3),
test_set
=> Algorithm::AM::DataSet->new(
cardinality
=> 3),
exclude_nulls
=> 0,
exclude_given
=> 0,
linear
=> 1,
probability
=> .5,
repeat
=> 2
);
ok(!
$batch
->exclude_nulls,
'exclude nulls turned off'
);
ok(!
$batch
->exclude_given,
'exclude given turned off'
);
ok(
$batch
->linear,
'pointer counting set to linear'
);
is(
$batch
->probability, .5,
'probability set to .5'
);
is(
$batch
->repeat, 2,
'repeat set to 2'
);
};
subtest
'configuration via accessors'
=>
sub
{
plan
tests
=> 5;
my
$batch
= Algorithm::AM::Batch->new(
training_set
=> Algorithm::AM::DataSet->new(
cardinality
=> 3),
test_set
=> Algorithm::AM::DataSet->new(
cardinality
=> 3),
);
$batch
->exclude_nulls(0);
$batch
->exclude_given(0);
$batch
->linear(1);
$batch
->probability(.5);
$batch
->repeat(2);
ok(!
$batch
->exclude_nulls,
'exclude nulls turned off'
);
ok(!
$batch
->exclude_given,
'exclude given turned off'
);
ok(
$batch
->linear,
'pointer counting set to linear'
);
is(
$batch
->probability, .5,
'probability set to .5'
);
is(
$batch
->repeat, 2,
'repeat set to 2'
);
};
return
;
}
sub
test_classify {
subtest
'run batch classification'
=>
sub
{
plan
tests
=> 8;
my
$train
= chapter_3_train();
my
$test
= chapter_3_test();
$test
->add_item(
$test
->get_item(0));
$train
->add_item(
$test
->get_item(0));
my
$batch
= Algorithm::AM::Batch->new(
training_set
=>
$train
,
repeat
=> 2,
exclude_nulls
=> 0,
exclude_given
=> 0,
linear
=> 1,
);
my
@results
=
$batch
->classify_all(
$test
);
is(
scalar
@results
, 4,
'2 items are analyzed twice'
) or
note
scalar
@results
;
isa_ok(
$results
[0],
'Algorithm::AM::Result'
);
isa_ok(
$results
[1],
'Algorithm::AM::Result'
);
isa_ok(
$results
[2],
'Algorithm::AM::Result'
);
isa_ok(
$results
[3],
'Algorithm::AM::Result'
);
ok(!
$results
[0]->given_excluded,
'exclude_given passed on to classifier'
);
ok(!
$results
[0]->exclude_nulls,
'exclude_nulls passed on to classifier'
);
is(
$results
[0]->count_method,
'linear'
,
'linear passed on to classifier'
);
};
return
;
}