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");