1#-*-CPerl-*-
2
3#########################
4use strict;
5use warnings;
6
7use Test::More;
8BEGIN { plan 'no_plan' };
9use lib qw( lib ../lib ../../lib ); #Just in case we are testing it in-place
10
11use Algorithm::Evolutionary qw( Individual::String Individual::BitString
12				Individual::Vector Individual::Tree
13				Fitness::ONEMAX);
14
15#########################
16
17# Insert your test code below, the Test module is use()ed here so read
18# its man page ( perldoc Test ) for help writing this test script.
19
20#String
21print "Testing Individual objects...String \n";
22is( ref Algorithm::Evolutionary::Individual::String->new(['a'..'z'],10), "Algorithm::Evolutionary::Individual::String", "Good ref" );
23is( ref Algorithm::Evolutionary::Individual::Base::create( 'String', { chars => ['a'..'e'], length => 10 }), "Algorithm::Evolutionary::Individual::String", "Good ref" );
24
25#Bitstring - 3 & 4
26print "BitString...\n";
27my $bs = Algorithm::Evolutionary::Individual::BitString->new(100);
28is( ref $bs, "Algorithm::Evolutionary::Individual::BitString", , "Good ref" );
29is( ref Algorithm::Evolutionary::Individual::Base::create( 'BitString', { length => 10 }), "Algorithm::Evolutionary::Individual::BitString", "Good ref" );
30
31#Vector - 5..7
32print "Vector...\n";
33is( ref Algorithm::Evolutionary::Individual::Vector->new(10), "Algorithm::Evolutionary::Individual::Vector", "Good ref" );
34is( ref Algorithm::Evolutionary::Individual::Base::create( 'Vector',
35							   { length => 20,
36							     rangestart => -5,
37							     rangeend => 5 }),
38    "Algorithm::Evolutionary::Individual::Vector", "Good ref" );
39
40my $primitives = { sum => [2, -1, 1],
41		   multiply => [2, -1, 1],
42		   substract => [2, -1, 1],
43		   divide => [2, -1, 1],
44		   x => [0, -10, 10],
45		   y => [0, -10, 10] };
46
47is( ref Algorithm::Evolutionary::Individual::Tree->new( $primitives, 3 ), "Algorithm::Evolutionary::Individual::Tree", "Good ref" );
48
49
50my $fitness = sub {
51  my $indi = shift;
52  return unpack("N", pack("B32", substr("0" x 32 . $indi->{'_str'}, -32)));
53};
54
55is( $bs->evaluate( $fitness ) > 0, 1, "Evaluation correct");
56my $fitness_obj = new Algorithm::Evolutionary::Fitness::ONEMAX;
57is( $bs->evaluate( $fitness_obj ) > 0, 1,  "Evaluation object correct" );
58
59my $bprime = new Algorithm::Evolutionary::Individual::String ['a'..'z'], 64;
60
61print "Testing algorithms\n";
62
63#test 33
64use Algorithm::Evolutionary::Op::LinearFreezer;
65use Algorithm::Evolutionary::Op::SimulatedAnnealing;
66
67my $m  = new Algorithm::Evolutionary::Op::Bitflip; #Changes a single bit
68my $initTemp = 2;
69my $minTemp = 0.1;
70my $freezer = new Algorithm::Evolutionary::Op::LinearFreezer( $initTemp );
71my $numChanges = 7;
72my $eval =
73  sub {
74    my $indi = shift;
75    my ( $x, $y ) = @{$indi->{_array}};
76    my $sqrt = sqrt( $x*$x+$y*$y);
77    return sin( $sqrt )/$sqrt;
78  };
79my $sa = new Algorithm::Evolutionary::Op::SimulatedAnnealing( $eval, $m, $freezer, $initTemp, $minTemp,  );
80is( ref $sa, 'Algorithm::Evolutionary::Op::SimulatedAnnealing', "Good class" );
81
82#test 34
83my $c = new Algorithm::Evolutionary::Op::Crossover; #Classical 2-point crossover
84my $replacementRate = 0.3;	#Replacement rate
85use Algorithm::Evolutionary::Op::RouletteWheel;
86my $popSize = 20;
87my $selector = new Algorithm::Evolutionary::Op::RouletteWheel $popSize; #One of the possible selectors
88use Algorithm::Evolutionary::Op::GeneralGeneration;
89my $onemax = sub {
90  my $indi = shift;
91  my $total = 0;
92  my $len = $indi->size();
93  my $i = 0;
94  while ($i < $len ) {
95    $total += substr($indi->{'_str'}, $i, 1);
96    $i++;
97  }
98  return $total;
99};
100my @pop;
101my $numBits = 20;
102for ( 0..$popSize ) {
103  my $indi = new Algorithm::Evolutionary::Individual::BitString $numBits ; #Creates random individual
104  my $fitness = $onemax->( $indi );
105  $indi->Fitness( $fitness );
106  push( @pop, $indi );
107}
108
109#fitness
110my $generation =
111  new Algorithm::Evolutionary::Op::GeneralGeneration( $onemax, $selector, [$m, $c], $replacementRate );
112my @sortPop = sort { $b->Fitness() <=> $a->Fitness() } @pop;
113my $bestIndi = $sortPop[0];
114$generation->apply( \@sortPop );
115is( $bestIndi->Fitness() <= $sortPop[0]->Fitness(), 1, "Fitness improvement" ); #fitness improves, but not always
116
117# To be obsoleted
118my $ggxml = $generation->asXML();
119my $gprime =  Algorithm::Evolutionary::Op::Base->fromXML( $ggxml );
120is( $gprime->{_eval}( $pop[0] ) eq $generation->{_eval}( $pop[0] ) , 1, "XML" ); #Code snippets will never be exactly the same.
121
122#Test 33 & 34
123use Algorithm::Evolutionary::Op::Easy;
124my $ez = new Algorithm::Evolutionary::Op::Easy $onemax;
125
126my $ezxml = $ez->asXML();
127my $ezprime = Algorithm::Evolutionary::Op::Base->fromXML( $ezxml );
128is( $ezprime->{_eval}( $pop[0] ) eq $ez->{_eval}( $pop[0] ) , 1, "Code snippets" ); #Code snippets will never be exactly the same.
129my $oldBestFitness = $bestIndi->Fitness();
130$ez->apply( \@sortPop );
131is( $sortPop[0]->Fitness() >= $oldBestFitness, 1, "Fitness improving");
132
133#Test 35 & 36
134use Algorithm::Evolutionary::Op::GenerationalTerm;
135my $g100 = new Algorithm::Evolutionary::Op::GenerationalTerm 10;
136use Algorithm::Evolutionary::Op::FullAlgorithm;
137my $f = new Algorithm::Evolutionary::Op::FullAlgorithm $generation, $g100;
138
139my $fxml = $f->asXML();
140my $txml = $f->{_terminator}->asXML();
141my $fprime = Algorithm::Evolutionary::Op::Base->fromXML( $fxml );
142is( $txml eq $fprime->{_terminator}->asXML() , 1, "from XML" );
143$oldBestFitness = $bestIndi->Fitness();
144for ( @sortPop ) {
145  if ( !defined $_->Fitness() ) {
146    my $fitness = $onemax->( $_ );
147    $_->Fitness( $fitness );
148  }
149}
150$f->apply( \@sortPop );
151is( $sortPop[0]->Fitness() >= $oldBestFitness, 1, "Improving fitness");
152
153=head1 Copyright
154
155  This file is released under the GPL. See the LICENSE file included in this distribution,
156  or go to http://www.fsf.org/licenses/gpl.txt
157
158  CVS Info: $Date: 2010/09/24 08:39:07 $
159  $Header: /media/Backup/Repos/opeal/opeal/Algorithm-Evolutionary/t/general.t,v 3.1 2010/09/24 08:39:07 jmerelo Exp $
160  $Author: jmerelo $
161  $Revision: 3.1 $
162  $Name $
163
164=cut
165