view release on metacpan or  search on metacpan

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

seed(map { oneish, 0.3, 0, 0.7, oneish, 0.5, 0.2, 0.1, 0.1, oneish, 0.4, 0, 0, 0, 0, 0 } (1..1000));
$population->breed();
@population = @{$population->blueprints};
my %accepted_sizes = (1 => 1, 256 => 1, 625 => 1, 1296 => 1);
for my $blueprint (@population) {
    ok(exists($accepted_sizes{length($blueprint->code)}), "new code has reasonable length ".length($blueprint->code));
}
BEGIN { $num_tests += 10 };


# new
$ref = ['abcdefghijklmnop'];
$population = Population->new(Host => 'whee', Generation => 20, Blueprints => $ref);
$ref = $population->blueprints;
is($population->physics->name,   'othello',
                                 'population->new sets physics right');
is($population->popsize,     5,  'population->new sets popsize right');
is($population->generation,  20, 'population->new sets generation right');
is($$ref[0]->code, 'abcdefghijklmnop', 'population->new sets blueprints right');
is($population->host,    'whee', 'population sets host right');
BEGIN { $num_tests += 5 };


# load
dies_ok(sub { Population->load('nonexistent_file') }, 'nonexistent file');
dies_ok(sub { Population->load('Build.PL') }, 'invalid file');
$population = Population->load('t/savefile');
is($population->physics->name,  'ttt', '$population->load gets physics right');
is($population->generation,      1001, '$population->load gets generation right');
is(new_popid(),                    23, '$population->load gets popid right');
$ref = $population->blueprints;
is(scalar @$ref, 3, '$population->load returned the right number of blueprints');
BEGIN { $num_tests += 6 };
@expected_results = (
    {id => -4,  code => $scorer3,  fitness =>  3, host => 'not_test1'},
    {id => -2,  code => $scorer2,  fitness =>  2, host => 'not_test'},
    {id => -10, code => $quit1,    fitness =>  1, host => 'test'},
);
for my $id (0..@expected_results-1) {
    is($$ref[$id]{id},      $expected_results[$id]{id},      "loaded $id id right");
    is($$ref[$id]{host},    $expected_results[$id]{host},    "loaded $id host right");
    is($$ref[$id]{code},    $expected_results[$id]{code},    "loaded $id code right");
    is($$ref[$id]{fitness}, $expected_results[$id]{fitness}, "loaded $id fitness right");
}
BEGIN { $num_tests += 4*3 };


package AI::Evolve::Befunge::Physics::test;
use strict;
use warnings;
use Carp;

# this is a boring, non-game physics engine.  Not much to see here.

use AI::Evolve::Befunge::Util;
use base 'AI::Evolve::Befunge::Physics';
use AI::Evolve::Befunge::Physics  qw(register_physics);

sub new {
    my $package = shift;
    return bless({}, $package);
}

sub get_token { return ord('-'); }

sub decorate_valid_moves { return 0; }
sub valid_move           { return 0; }
sub won                  { return 0; }
sub over                 { return 0; }
sub score                { return 0; }
sub can_pass             { return 0; }
sub make_move            { return 0; }
sub setup_board          { return 0; }

BEGIN { register_physics(
        name => "test",
);};