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