view release on metacpan or  search on metacpan

t/09population.t  view on Meta::CPAN

#!/usr/bin/perl
use strict;
use warnings;

use Cwd;
use File::Temp qw(tempdir);
use Test::More;
use Test::Exception;
use Test::MockRandom {
    rand => [qw(AI::Evolve::Befunge::Population Algorithm::Evolutionary::Wheel)],
    srand => { main => 'seed' },
    oneish => [qw(main)]
};

BEGIN { $ENV{AIEVOLVEBEFUNGE} = 't/testconfig.conf'; };

use aliased 'AI::Evolve::Befunge::Population' => 'Population';
use aliased 'AI::Evolve::Befunge::Blueprint'  => 'Blueprint';
use AI::Evolve::Befunge::Util;

push_quiet(1);

my $num_tests;
BEGIN { $num_tests = 0; };
plan tests => $num_tests;


# constructor
$ENV{HOST} = 'test';
my $population;
lives_ok(sub { $population = Population->new() }, 'defaults work');
is($population->physics->name, 'ttt' , 'default physics used');
is($population->popsize , 40         , 'default popsize used');
set_popid(1);
$population = Population->new(Host => 'host');
my $population2 = Population->new(Host => 'phost');
is(ref($population), 'AI::Evolve::Befunge::Population', 'ref to right class');
is($population2->popsize,   8, 'popsize passed through correctly');
is(ref($population->physics),  'AI::Evolve::Befunge::Physics::ttt',
                               'physics created properly');
is(ref($population2->physics), 'AI::Evolve::Befunge::Physics::test',
                               'physics created properly');
is($population->dimensions, 4, 'correct dimensions');
is($population->generation, 1, 'default generation');
BEGIN { $num_tests += 9 };


# default blueprints
my $listref = $population->blueprints;
is(scalar @$listref, 10, 'default blueprints created');
foreach my $i (0..7) {
    my $individual = $$listref[$i];
    my $code = $individual->code;
    is(index($code, "\0"), -1, "new_code_fragment contains no nulls");
    is(length($code), 256, "newly created blueprints have right code size");
}
BEGIN { $num_tests += 17 };


# new_code_fragment
seed(0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my $code = $population->new_code_fragment(10, 0);
is(index($code, "\0"), -1, "new_code_fragment contains no nulls");
is(length($code), 10, "new_code_fragment obeys length parameter");
is($code, ' 'x10, 'prob=0 means I get a blank line');
seed(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
$code = $population->new_code_fragment(10, 100);
is(index($code, "\0"), -1, "new_code_fragment contains no nulls");
is(length($code), 10, "new_code_fragment obeys length parameter");
is($code, '0'x10, 'prob=100 means I get a line of code');
seed(oneish, oneish, oneish, oneish, oneish, oneish, oneish, oneish);
is($population->new_code_fragment( 4, 120), 'TTTT', 'Physics-specific commands are generated');
seed(oneish, oneish, oneish, oneish, oneish, oneish, oneish, oneish);
is($population2->new_code_fragment(4, 120), "''''", 'No Physics-specific commands are generated when the Physics has none.');
dies_ok(sub { AI::Evolve::Befunge::Population::new_code_fragment(1) }, "no self ptr");
dies_ok(sub { $population->new_code_fragment()  }, "no length");
dies_ok(sub { $population->new_code_fragment(5) }, "no density");
BEGIN { $num_tests += 11 };


# mutate
my $blank = Blueprint->new( code => " "x256, dimensions => 4, id => -10 );
seed(0.3,0,0,0,0,0,0,0);
$population->mutate($blank);
is($blank->code, " "x64 . "0"x192, 'big mutate');
$blank->code(" "x256);
seed(0,0,0,0,oneish,oneish,oneish,oneish);
$population->mutate($blank);
is($$blank{code}, '0' . (' 'x255), 'small mutate');
is(index($blank->code, "\0"), -1, "mutate() does not create nulls");
BEGIN { $num_tests += 3 };


# crossover
my $chromosome1 = Blueprint->new( code => "1"x256, dimensions => 4, id => -11 );
my $chromosome2 = Blueprint->new( code => "2"x256, dimensions => 4, id => -12 );
my $chromosome3 = Blueprint->new( code => "3"x16 , dimensions => 4, id => -13 );
my $chromosome4 = Blueprint->new( code => "4"x16 , dimensions => 4, id => -14 );
seed(0.3,0,0,0,0,0,0,0);
$population->crossover($chromosome1, $chromosome2);
is($$chromosome1{code}, "1"x64 . "2"x192, 'big crossover 1');
is($$chromosome2{code}, "2"x64 . "1"x192, 'big crossover 2');
$chromosome1 = Blueprint->new( code => "1"x256, dimensions => 4, id => -13 );
$chromosome2 = Blueprint->new( code => "2"x256, dimensions => 4, id => -14 );
seed(0,0,0,0,oneish,oneish,oneish,oneish);
$population->crossover($chromosome1, $chromosome2);
is($$chromosome1{code}, "2" . "1"x255, 'small crossover 1');
is($$chromosome2{code}, "1" . "2"x255, 'small crossover 2');
seed(0,0,0,0,oneish,oneish,oneish,oneish);
$population->crossover($chromosome1, $chromosome3);