view release on metacpan or  search on metacpan

t/general.t  view on Meta::CPAN

#-*-CPerl-*-

#########################
use strict;
use warnings;

use Test::More;
BEGIN { plan 'no_plan' };
use lib qw( lib ../lib ../../lib ); #Just in case we are testing it in-place

use Algorithm::Evolutionary qw( Individual::String Individual::BitString 
				Individual::Vector Individual::Tree 
				Fitness::ONEMAX);

#########################

# Insert your test code below, the Test module is use()ed here so read
# its man page ( perldoc Test ) for help writing this test script.

#String
print "Testing Individual objects...String \n";
is( ref Algorithm::Evolutionary::Individual::String->new(['a'..'z'],10), "Algorithm::Evolutionary::Individual::String", "Good ref" );
is( ref Algorithm::Evolutionary::Individual::Base::create( 'String', { chars => ['a'..'e'], length => 10 }), "Algorithm::Evolutionary::Individual::String", "Good ref" );

#Bitstring - 3 & 4
print "BitString...\n";
my $bs = Algorithm::Evolutionary::Individual::BitString->new(100);
is( ref $bs, "Algorithm::Evolutionary::Individual::BitString", , "Good ref" );
is( ref Algorithm::Evolutionary::Individual::Base::create( 'BitString', { length => 10 }), "Algorithm::Evolutionary::Individual::BitString", "Good ref" );

#Vector - 5..7
print "Vector...\n";
is( ref Algorithm::Evolutionary::Individual::Vector->new(10), "Algorithm::Evolutionary::Individual::Vector", "Good ref" );
is( ref Algorithm::Evolutionary::Individual::Base::create( 'Vector', 
							   { length => 20,
							     rangestart => -5,
							     rangeend => 5 }), 
    "Algorithm::Evolutionary::Individual::Vector", "Good ref" );

my $primitives = { sum => [2, -1, 1],
		   multiply => [2, -1, 1],
		   substract => [2, -1, 1],
		   divide => [2, -1, 1],
		   x => [0, -10, 10],
		   y => [0, -10, 10] };

is( ref Algorithm::Evolutionary::Individual::Tree->new( $primitives, 3 ), "Algorithm::Evolutionary::Individual::Tree", "Good ref" );


my $fitness = sub {
  my $indi = shift;
  return unpack("N", pack("B32", substr("0" x 32 . $indi->{'_str'}, -32)));
};

is( $bs->evaluate( $fitness ) > 0, 1, "Evaluation correct");
my $fitness_obj = new Algorithm::Evolutionary::Fitness::ONEMAX;
is( $bs->evaluate( $fitness_obj ) > 0, 1,  "Evaluation object correct" );

my $bprime = new Algorithm::Evolutionary::Individual::String ['a'..'z'], 64;

print "Testing algorithms\n";

#test 33
use Algorithm::Evolutionary::Op::LinearFreezer;
use Algorithm::Evolutionary::Op::SimulatedAnnealing;

my $m  = new Algorithm::Evolutionary::Op::Bitflip; #Changes a single bit
my $initTemp = 2;
my $minTemp = 0.1;
my $freezer = new Algorithm::Evolutionary::Op::LinearFreezer( $initTemp );
my $numChanges = 7;
my $eval =  
  sub {
    my $indi = shift;
    my ( $x, $y ) = @{$indi->{_array}};
    my $sqrt = sqrt( $x*$x+$y*$y);
    return sin( $sqrt )/$sqrt;
  };
my $sa = new Algorithm::Evolutionary::Op::SimulatedAnnealing( $eval, $m, $freezer, $initTemp, $minTemp,  );
is( ref $sa, 'Algorithm::Evolutionary::Op::SimulatedAnnealing', "Good class" );

#test 34
my $c = new Algorithm::Evolutionary::Op::Crossover; #Classical 2-point crossover
my $replacementRate = 0.3;	#Replacement rate
use Algorithm::Evolutionary::Op::RouletteWheel;
my $popSize = 20;
my $selector = new Algorithm::Evolutionary::Op::RouletteWheel $popSize; #One of the possible selectors
use Algorithm::Evolutionary::Op::GeneralGeneration;
my $onemax = sub { 
  my $indi = shift;
  my $total = 0;
  my $len = $indi->size();
  my $i = 0;
  while ($i < $len ) {
    $total += substr($indi->{'_str'}, $i, 1);
    $i++;