1# Before `make install' is performed this script should be runnable with
2# `make test'. After `make install' it should work as `perl test.pl'
3
4#########################
5
6# change 'tests => 1' to 'tests => last_test_to_print';
7
8use Test;
9BEGIN { plan tests => 1 };
10
11use Algorithm::SVM::DataSet;
12use Algorithm::SVM;
13
14ok(1); # If we made it this far, we're ok.
15
16#########################
17
18# Insert your test code below, the Test module is use()ed here so read
19# its man page ( perldoc Test ) for help writing this test script.
20
21print("Creating new Algorithm::SVM\n");
22my $svm = new Algorithm::SVM(Model => 'sample.model');
23ok(ref($svm) ne "", 1);
24
25print("Creating new Algorithm::SVM::DataSet objects\n");
26my $ds1 = new Algorithm::SVM::DataSet(Label => 1);
27my $ds2 = new Algorithm::SVM::DataSet(Label => 2);
28my $ds3 = new Algorithm::SVM::DataSet(Label => 3);
29ok(ref($ds1) ne "", 1);
30ok(ref($ds2) ne "", 1);
31ok(ref($ds3) ne "", 1);
32
33print("Adding attributes to Algorithm::SVM::DataSet objects\n");
34my @d1 = (0.0424107142857143, 0.0915178571428571, 0.0401785714285714,
35	  0.0156250000000000, 0.0156250000000000, 0.0223214285714286,
36	  0.0223214285714286, 0.0825892857142857, 0.1205357142857140,
37	  0.0736607142857143, 0.0535714285714286, 0.0535714285714286,
38	  0.0178571428571429, 0.0357142857142857, 0.1116071428571430,
39	  0.0334821428571429, 0.0223214285714286, 0.0602678571428571,
40	  0.0200892857142857, 0.0647321428571429);
41
42my @d2 = (0.0673076923076923, 0.11538461538461500, 0.0480769230769231,
43	  0.0480769230769231, 0.00961538461538462, 0.0192307692307692,
44	  0.0000000000000000, 0.08653846153846150, 0.1634615384615380,
45	  0.0865384615384615, 0.03846153846153850, 0.0288461538461538,
46	  0.0192307692307692, 0.01923076923076920, 0.0000000000000000,
47	  0.0961538461538462, 0.02884615384615380, 0.0673076923076923,
48	  0.0288461538461538, 0.02884615384615380);
49
50my @d3 = (0.0756756756756757, 0.0594594594594595, 0.0378378378378378,
51	  0.0216216216216216, 0.0432432432432432, 0.0000000000000000,
52	  0.0162162162162162, 0.0648648648648649, 0.1729729729729730,
53	  0.0432432432432432, 0.0864864864864865, 0.1297297297297300,
54	  0.0108108108108108, 0.0108108108108108, 0.0162162162162162,
55	  0.0486486486486487, 0.0324324324324324, 0.0216216216216216,
56	  0.0594594594594595, 0.0486486486486487);
57
58$ds1->attribute($_, $d1[$_ - 1]) for(1..scalar(@d1));
59$ds2->attribute($_, $d2[$_ - 1]) for(1..scalar(@d2));
60$ds3->attribute($_, $d3[$_ - 1]) for(1..scalar(@d3));
61ok(1);
62
63print("Checking predictions on loaded model\n");
64ok($svm->predict($ds1) == 10,1);
65ok($svm->predict($ds2) == 0,1);
66ok($svm->predict($ds3) == -10,1);
67
68print("Saving model\n");
69ok($svm->save('sample.model.1'), 1);
70
71print("Loading saved model\n");
72ok($svm->load('sample.model.1'), 1);
73
74print("Checking NRClass\n");
75ok($svm->getNRClass(), 3);
76
77print("Checking model labels\n");
78ok($svm->getLabels(), (10, 0, -10));
79
80my $cnt=0;
81for (my $i=1; $i<=@d1; $i++) {
82  if ($ds1->attribute($i) == $d1[$i-1]) {
83		$cnt++;
84	}
85}
86ok($cnt,20);
87
88print("Checking train\n");
89my @tset=($ds1,$ds2,$ds3);
90ok($svm->train(@tset));
91
92$cnt=0;
93for (my $i=1; $i<=@d1; $i++) {
94  if ($ds1->attribute($i) == $d1[$i-1]) {
95		$cnt++;
96	}
97}
98ok($cnt,20);
99
100
101print("Checking retrain\n");
102
103my $p1 = $svm->predict($ds1);
104my $p2 = $svm->predict($ds2);
105my $p3 = $svm->predict($ds3);
106
107ok($svm->retrain());
108
109ok($svm->predict($ds1),$p1);
110ok($svm->predict($ds2),$p2);
111ok($svm->predict($ds3),$p3);
112
113print("Checking retrain after DataSet changes\n");
114# this tests whether reallocating memory after realign
115# works ok.
116$ds1->attribute(2,$ds1->attribute(2));
117$ds2->attribute(2,$ds2->attribute(2));
118$ds3->attribute(2,$ds3->attribute(2));
119
120ok($svm->retrain());
121
122ok($svm->predict($ds1),$p1);
123ok($svm->predict($ds2),$p2);
124ok($svm->predict($ds3),$p3);
125
126print("Checking svm destructor\n");
127
128$svm=undef; # destroy svm object (test destructor)
129ok(1);
130
131print("Checking attribute value changes\n");
132$ds1->attribute($_, 1) for(1..scalar(@d1));
133$cnt=0;
134for ($i=1;$i<=scalar(@d1);$i++) {
135  if ($ds1->attribute($i)==1) { $cnt++; } else { print $ds1->attribute($i),"::\n"; }
136}
137ok($cnt,20);
138
139$ds2->attribute(3, -1.5);
140$ds2->attribute(5, -1.5);
141$ds2->attribute(4, -1.5);
142$ds2->attribute(2, -1.5);
143$ds2->attribute(1, -1.5);
144$cnt=0;
145for ($i=1;$i<=5;$i++) {
146  if ($ds2->attribute($i)==-1.5) { $cnt++; }
147}
148for ($i=6;$i<=scalar(@d2);$i++) {
149  if ($ds2->attribute($i)==$d2[$i-1]) { $cnt++; }
150}
151ok($cnt,20);
152
153$ds3->attribute($_, 0) for(1..scalar(@d3));
154$cnt=0;
155for ($i=1;$i<=scalar(@d3);$i++) {
156  if ($ds3->attribute($i)==0) { $cnt++; }
157}
158ok($cnt,20);
159
160print("Checking asArray\n");
161
162my @x = $ds2->asArray();
163# note that this takes attr. 0 as first value, which has never
164# been set and thus is equal to zero
165$cnt=0;
166if ($x[0]==0.0) { $cnt++; }
167for ($i=1;$i<=5;$i++) {
168  if ($x[$i]==-1.5) { $cnt++; }
169}
170for ($i=6;$i<=scalar(@d2);$i++) {
171  if ($x[$i]==$d2[$i-1]) { $cnt++; }
172}
173ok($cnt,21);
174