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