AI-Evolve-Befunge
view release on metacpan or search on metacpan
(1) You are permitted to use the Standard Version and create and use
Modified Versions for any purpose without restriction, provided that
you do not Distribute the Modified Version.
Permissions for Redistribution of the Standard Version
(2) You may Distribute verbatim copies of the Source form of the
Standard Version of this Package in any medium without restriction,
either gratis or for a Distributor Fee, provided that you duplicate
all of the original copyright notices and associated disclaimers. At
your discretion, such verbatim copies may or may not include a
Compiled form of the Package.
(3) You may apply any bug fixes, portability changes, and other
modifications made available from the Copyright Holder. The resulting
Package will still be considered the Standard Version, and as such
will be subject to the Original License.
Distribution of Modified Versions of the Package as Source
lib/AI/Evolve/Befunge/Critter.pm view on Meta::CPAN
=head1 DESCRIPTION
This module is where the actual execution of Befunge code occurs. It
contains everything necessary to set up and run the code in a safe
(sandboxed) Befunge universe.
This universe contains the Befunge code (obviously), as well as the
current board game state (if any). The Befunge code exists in the
negative vector space (with the origin at 0, Befunge code is below
zero on all axes). Board game info, if any, exists as a square (or
hypercube) which starts at the origin.
The layout of befunge code space looks like this (for a 2d universe):
|----------| |
|1 | |
|09876543210123456789|
---+--------------------+---
-10|CCCCCCCCCC |-10
-9|CCCCCCCCCC| | -9
-8|CCCCCCCCCC | -8
lib/AI/Evolve/Befunge/Physics.pm view on Meta::CPAN
sub new {
my ($package, $physics) = @_;
my $usage = 'Usage: Physics->new($physicsname);';
croak($usage) unless defined($package);
croak($usage) unless defined($physics);
my $module = 'AI::Evolve::Befunge::Physics::' . $physics;
$module->require;
my $rv = find_physics($physics);
croak("no such physics module found") unless defined $rv;
$rv = {%$rv}; # copy of the original object
return bless($rv, $module);
}
=head1 METHODS
Once you have obtained a class instance by calling ->new(), you may
call the following methods on that instance.
=head2 run_board_game
lib/AI/Evolve/Befunge/Population.pm view on Meta::CPAN
delete($$chr2{cache});
}
=head2 crop
$population->crop($blueprint);
Possibly (1 in 10 chance) reduce the size of a blueprint. Each side
of the hypercube shall have its length reduced by 1. The preserved
section of the original code will be at a random offset (0 or 1 on each
axis).
=cut
sub crop {
my ($self, $chromosome) = @_;
return $chromosome if int(rand(10));
my $nd = $chromosome->dims;
my $old_size = $chromosome->size;
return $chromosome if $old_size->get_component(0) < 4;
lib/AI/Evolve/Befunge/Population.pm view on Meta::CPAN
}
return AI::Evolve::Befunge::Blueprint->new(code => $new_code, dimensions => $nd);
}
=head2 grow
$population->grow($blueprint);
Possibly (1 in 10 chance) increase the size of a blueprint. Each side
of the hypercube shall have its length increased by 1. The original
code will begin at the origin, so that the same code executes first.
=cut
sub grow {
my ($self, $chromosome) = @_;
return $chromosome if int(rand(10));
my $nd = $chromosome->dims;
my $old_size = $chromosome->size;
my $old_base = Language::Befunge::Vector->new_zeroes($nd);
my $new_base = $old_base->copy();
t/04board.t view on Meta::CPAN
dies_ok( sub { $board->set_value(v(0,-1), 1) }, 'set_value out of range');
like($@, qr/out of range/, "died with proper message");
dies_ok( sub { $board->set_value(v(0,5), 1) }, 'set_value out of range');
like($@, qr/out of range/, "died with proper message");
dies_ok( sub { $board->set_value(v(0,0), -1) }, 'set_value out of range');
like($@, qr/data '-1' out of range/, "died with proper message");
dies_ok( sub { $board->set_value(v(0,0), 40) }, 'set_value out of range');
like($@, qr/data '40' out of range/, "died with proper message");
dies_ok( sub { $board->set_value(v(0,0), undef) }, 'set_value with undef value');
like($@, qr/undef value/, "died with proper message");
is($board->fetch_value(v(0,0)), 0, "above deaths didn't affect original value");
BEGIN { $num_tests += 28 };
# copy
my $board2 = $board->copy();
is($board->fetch_value(v(2,2)), 2, "old copy has same values");
is($board->fetch_value(v(4,4)), 0, "old copy has same values");
is($board2->fetch_value(v(2,2)), 2, "new copy has same values");
is($board2->fetch_value(v(4,4)), 0, "new copy has same values");
$board2->set_value(v(2,2),0);
$board2->set_value(v(4,4),2);
t/09population.t view on Meta::CPAN
seed(0,0,0,0,oneish,oneish,oneish,oneish);
$population->crossover($chromosome4, $chromosome2);
is(length($chromosome4->code), 256, 'crossover upgrades size');
is(length($chromosome2->code), 256, 'crossover does not upgrade bigger blueprint');
BEGIN { $num_tests += 8 };
# grow
$chromosome3 = Blueprint->new( code => "3"x16 , dimensions => 4, id => -13 );
seed(0);
my $chromosome5 = $population->grow($chromosome3);
is($chromosome3->size, '(2,2,2,2)', 'verify original size');
is($chromosome5->size, '(3,3,3,3)', 'verify new size');
is($chromosome5->code,
'33 '.'33 '.' '
.'33 '.'33 '.' '
.' '.' '.' '
.'33 '.'33 '.' '
.'33 '.'33 '.' '
.' '.' '.' '
.' '.' '.' '
.' '.' '.' '
t/09population.t view on Meta::CPAN
$chromosome3 = Blueprint->new( code =>
"334334555334334555555555555334334555334334555555555555555555555555555555555555555",
dimensions => 4, id => -13 );
$chromosome4 = Blueprint->new( code =>
"3334333433344444333433343334444433343334333444444445444544455555",
dimensions => 3, id => -14 );
seed(0, 0, 0, 0, 0);
seed(0, 0, 0, 0);
$chromosome5 = $population->crop($chromosome3);
my $chromosome6 = $population->crop($chromosome4);
is($chromosome3->size, '(3,3,3,3)', 'verify original size');
is($chromosome5->size, '(3,3,3,3)', 'verify same size');
is($chromosome4->size, '(4,4,4)', 'verify original size');
is($chromosome6->size, '(3,3,3)', 'verify new size');
is($chromosome6->code, '3'x27, "crop at zero offset");
seed(0, oneish, oneish, oneish, oneish, 0, oneish, oneish, oneish);
$chromosome6 = $population->crop($chromosome4);
is($chromosome4->size, '(4,4,4)', 'verify original size');
is($chromosome6->size, '(3,3,3)', 'verify new size');
is($chromosome6->code, '334334444334334444445445555', "crop at nonzero offset");
BEGIN { $num_tests += 8 };
# fight
# we're executing in a 4-dimensional space, so code size must be one of:
# 1**4 = 1
# 2**4 = 16
# 3**4 = 81
t/09population.t view on Meta::CPAN
my @population = map { Blueprint->new( code => $_, dimensions => 4, id => $popid++, host => 'test' ) }
($quit1,$quit1,$concede1,$concede1,$dier1,$dier1,$scorer3,$scorer1,$scorer2, $scorer2);
$population[3]{host} = 'not_test';
$population[6]{host} = 'not_test1';
$population[7]{host} = 'not_test2';
$population[8]{host} = 'not_test';
seed(0.3, 0, 0.7, oneish);
$population->blueprints([@population]);
$population->fight();
@population = @{$population->blueprints};
is(scalar @population, 3, 'population reduced to 25% of its original size');
BEGIN { $num_tests += 1 };
my @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'},
);
my $ref = $population->blueprints;
for my $id (0..@expected_results-1) {
is($$ref[$id]{id}, $expected_results[$id]{id}, "sorted $id id right");
is($$ref[$id]{fitness}, $expected_results[$id]{fitness}, "sorted $id fitness right");
( run in 1.662 second using v1.01-cache-2.11-cpan-f985c23238c )