AI-Evolve-Befunge
view release on metacpan or search on metacpan
AI::Evolve::Befunge
=====================================
This is an evolutionary algorithm module written in Perl. It produces small
programs in a language named Befunge, which have been determined to fit a
specified set of criteria.
It is designed to provide a practical means of evolving useful AI programs.
It takes a while to run but has verifiable results.
Please see the POD documentation included in the AI::Evolve::Befunge module
itself, for the details.
INSTALLATION
example.conf view on Meta::CPAN
# This is an example config file for AI::Evolve::Befunge.
# It can be installed as ~/.ai-evolve-befunge or /etc/ai-evolve-befunge.conf.
# All of the valid settings are listed below, along with their default values.
# This config file is in YAML format. If you're not familiar with it, just
# follow the syntax as shown below, and everything will work out just fine.
# NORMAL OPERATING PARAMETERS
# Select the physics engine for this instance. This is "othello", "ttt",
# or any other module under the AI::Evolve::Befunge::Physics:: namespace.
physics: ttt
example.conf view on Meta::CPAN
# Hostname or IP address to connect to. See tools/migrationd for more info.
migrationd_host: quack.glines.org
# TCP port to connect to.
migrationd_port: 29522
# LOW LEVEL STUFF
# The number of dimensions newly created critters will operate in. This
# setting only has an effect on the first generation (after that, it is
# inherited).
dimensions: 3
# The percentage of code (versus whitespace) from the random code generator.
code_density: 70
# Like code_density, above, but only applies to the first generation (or the
# first after resuming a saved results file).
initial_code_density: 90
lib/AI/Evolve/Befunge.pm view on Meta::CPAN
is generated from the winners, some random mutation (random
generation of code, as well as potentially resizing the codebase)
occurs, and the whole process starts over for the next generation.
=head1 PHYSICS
At the other end of all of this is the Physics plugin. The Physics
plugin implements the rules of the universe inhabited by these AI
creatures. It provides a scoring mechanism through which multiple
critters may be weighed against eachother. It provides a set of
commands which may be used by the critters to do useful things within
its universe (such as make a move in a board game, do a spellcheck,
or request a google search).
Physics engines register themselves with the Physics database (which
is managed by Physics.pm). The arguments they pass to
register_physics() get wrapped up in a hash reference, which is copied
for you whenever you call Physics->new("pluginname"). The "commands"
argument is particularly important: this is where you add special
befunge commands and provide references to callback functions to
implement them.
One special attribute, "generations", is set by the Population code
and can determine some of the parameters for more complex Physics
plugins. For instance, a "Go" game might wish to increase the board
size, or enable more complex rules, once a certain amount of evolution
has occurred.
Rather than describing the entire API in detail, I suggest you read
through the "othello" and "ttt" modules provided along with this
distribution. They are small and simple, and should make good
examples.
=head1 MIGRATION
Further performance may be improved through the use of migration.
Migration is a very simple form of parallel processing. It should scale
nearly linearly, and is a very effective means of increasing performance.
The idea is, you run multiple populations on multiple machines (one per
machine). The only requirement is that each Population has a different
"hostname" setting. And that's not really a requirement, it's just useful
for tracking down which host a critter came from.
When a Population object has finished processing a generation, there is
a chance that one or more (up to 3) of the surviving critters will be
written out to a special directory (which acts as an "outbox").
A separate networking program (implemented by Migrator.pm and spawned
automatically when creating a Population object) may pick up these
critters and broadcast them to some or all of the other nodes in a cluster
(deleting them from the "outbox" folder at the same time). The instances
lib/AI/Evolve/Befunge.pm view on Meta::CPAN
You can find an example config file ("example.conf") in the source
tarball. It contains all of the variables with their default values,
and descriptions of each. It lets you configure many important
parameters about how the evolutionary process works, so you probably
want to copy and edit it.
This file can be copied to ".ai-evolve-befunge" in your home
directory, or "/etc/ai-evolve-befunge.conf" for sitewide use. If both
files exist, they are both loaded, in such a way that the homedir
settings supercede the ones from /etc. If the "AIEVOLVEBEFUNGE"
environment variable is set, that too is loaded as a config file, and
its settings take priority over the other files (if any).
=cut
1;
lib/AI/Evolve/Befunge/Blueprint.pm view on Meta::CPAN
Return a unique identifier.
=cut
sub new_popid :Export(:DEFAULT) {
$_popid = 0 unless defined $_popid;
return $_popid++;
}
=head2 set_popid
set_popid($id);
Initialize the iterator to the given value. This is typically done
when a new process reads a results file, to keep node identifiers
unique across runs.
=cut
sub set_popid :Export(:DEFAULT) {
$_popid = shift;
}
}
new_popid();
=head1 AUTHOR
Mark Glines <mark-cpan@glines.org>
lib/AI/Evolve/Befunge/Board.pm view on Meta::CPAN
__PACKAGE__->mk_accessors( qw{ size dimensions } );
=head1 NAME
AI::Evolve::Befunge::Board - board game object
=head1 SYNOPSIS
my $board = AI::Evolve::Befunge::Board->new(Size => $vector);
$board->set_value($vector, $value);
$board->clear();
=head1 DESCRIPTION
This module tracks board-game state for AI::Evolve::Befunge. It is only used
for board-game-style physics, like tic tac toe, othello, go, chess, etc.
Non-boardgame applications do not use a Board object.
lib/AI/Evolve/Befunge/Board.pm view on Meta::CPAN
return $self;
}
=head1 METHODS
=head2 clear
$board->clear();
Clear the board - set all spaces to 0.
=cut
sub clear {
my $self = shift;
$$self{b} = [];
for(0..$$self{sizey}-1) {
push(@{$$self{b}}, [ map { 0 } (0..$$self{sizex}-1)]);
}
}
lib/AI/Evolve/Befunge/Board.pm view on Meta::CPAN
sub fetch_value {
my ($self, $v) = @_;
croak("need a vector argument") unless ref($v) eq 'Language::Befunge::Vector';
my ($x, $y, @overflow) = $v->get_all_components();
croak "fetch_value: x value '$x' out of range!" if $x < 0 or $x >= $$self{sizex};
croak "fetch_value: y value '$y' out of range!" if $y < 0 or $y >= $$self{sizey};
return $$self{b}[$y][$x];
}
=head2 set_value
$board->fetch_value($vector, $value);
Set the value of the board space specified by the vector argument.
=cut
sub set_value {
my ($self, $v, $val) = @_;
croak("need a vector argument") unless ref($v) eq 'Language::Befunge::Vector';
my ($x, $y, @overflow) = $v->get_all_components();
croak "set_value: x value '$x' out of range!" if $x < 0 or $x >= $$self{sizex};
croak "set_value: y value '$y' out of range!" if $y < 0 or $y >= $$self{sizey};
croak "undef value!" unless defined $val;
croak "data '$val' out of range!" unless $val >= 0 && $val < 3;
$$self{b}[$y][$x] = $val;
}
=head2 copy
my $new_board = $board->copy();
Create a new copy of the board.
=cut
sub copy {
my ($self) = @_;
my $new = ref($self)->new(Size => $$self{size});
my $min = Language::Befunge::Vector->new_zeroes($$self{dimensions});
my $max = Language::Befunge::Vector->new(map { $_ - 1 } ($$self{size}->get_all_components));
for(my $this = $min->copy; defined $this; $this = $this->rasterize($min,$max)) {
$new->set_value($this,$self->fetch_value($this));
}
return $new;
}
1;
lib/AI/Evolve/Befunge/Critter.pm view on Meta::CPAN
use aliased 'AI::Evolve::Befunge::Critter::Result' => 'Result';
=head1 NAME
AI::Evolve::Befunge::Critter - critter execution environment
=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):
lib/AI/Evolve/Befunge/Critter.pm view on Meta::CPAN
=item Number of stacks
=item Storage size (electric fence)
=item Number of threads
=item "k" command repeat count
=item "j" command jump count
=item "x" command dead IP checks (setting a null vector)
=back
Most of the above things will result in spending some tokens. There
are a couple of exceptions to this: a storage write outside the
confines of the critter's fence will result in the interpreter
crashing and the critter dying with it; similarly, a huge "j" jump
count will also kill the critter.
The following commands are removed entirely from the interpreter's Ops
lib/AI/Evolve/Befunge/Critter.pm view on Meta::CPAN
If not specified, this will be pulled from the variable "itercost" in
the config file. If that can't be found, a default value of 2 is
used.
=item RepeatCost
This is the number of tokens the critter pays for each time a command
is repeated (with the "k" instruction). It makes sense for this value
to be lower than the IterCost setting, as it is somewhat more
efficient.
If not specified, this will be pulled from the variable "repeatcost"
in the config file. If that can't be found, a default value of 1 is
used.
=item StackCost
This is the number of tokens the critter pays for each time a value
lib/AI/Evolve/Befunge/Critter.pm view on Meta::CPAN
map { 1 } (1..$$self{dims}-$$self{boardsize}->get_dims())
);
}
}
$$self{color} = $args{Color};
croak "Color must be greater than 0" unless $$self{color} > 0;
$$self{physics} = $args{Physics};
croak "Physics must be a reference" unless ref($$self{physics});
# set up our corral to be twice the size of our code or our board, whichever
# is bigger.
my $maxpos = Language::Befunge::Vector->new_zeroes($$self{dims});
foreach my $dim (0..$$self{dims}-1) {
if(!exists($$self{boardsize})
||($$self{codesize}->get_component($dim) > $$self{boardsize}->get_component($dim))) {
$maxpos->set_component($dim, $$self{codesize}->get_component($dim));
} else {
$maxpos->set_component($dim, $$self{boardsize}->get_component($dim));
}
}
my $minpos = Language::Befunge::Vector->new_zeroes($$self{dims}) - $maxpos;
my $maxlen = 0;
foreach my $d (0..$$self{dims}-1) {
my $this = $maxpos->get_component($d) - $minpos->get_component($d);
$maxlen = $this if $this > $maxlen;
}
$$self{maxsize} = $maxpos;
$$self{minsize} = $minpos;
$$self{maxlen} = $maxlen;
my $interp = Language::Befunge::Interpreter->new({
dims => $$self{dims},
storage => 'Language::Befunge::Storage::Generic::Vec'
});
$$self{interp} = $interp;
$$self{codeoffset} = $minpos;
my $cachename = "storagecache-".$$self{dims};
if(exists($$self{blueprint}{cache})
&& exists($$self{blueprint}{cache}{$cachename})) {
$$interp{storage} = $$self{blueprint}{cache}{$cachename}->_copy;
} else {
if($$self{dims} > 1) {
# split code into lines, pages, etc as necessary.
my @lines;
my $meas = $$self{codesize}->get_component(0);
my $dims = $$self{dims};
lib/AI/Evolve/Befunge/Critter.pm view on Meta::CPAN
foreach my $dim (0..$dims-1) {
my $offs = 1;
$offs *= $meas for (1..$dim-1);
for(my $i = $offs; $i <= scalar @lines; $i += $offs) {
$lines[$i-1] .= $terms[$dim];
}
}
$$self{code} = join("", @lines);
}
$interp->get_storage->store($$self{code}, $$self{codeoffset});
# assign our corral size to the befunge space
$interp->get_storage->expand($$self{minsize});
$interp->get_storage->expand($$self{maxsize});
# save off a copy of this befunge space for later reuse
$$self{blueprint}{cache} = {} unless exists $$self{blueprint}{cache};
$$self{blueprint}{cache}{$cachename} = $interp->get_storage->_copy;
}
my $storage = $interp->get_storage;
$$storage{maxsize} = $$self{maxsize};
$$storage{minsize} = $$self{minsize};
lib/AI/Evolve/Befunge/Critter.pm view on Meta::CPAN
push(@vectors, $$self{boardsize}) if exists $$self{boardsize};
push(@vectors, $$self{maxsize}, $$self{codesize});
foreach my $vec (@vectors) {
push(@params, $vec->get_all_components());
push(@params, 1) for($vec->get_dims()+1..$$self{dims});
}
push(@params, $$self{threadcost}, $$self{stackcost}, $$self{repeatcost},
$$self{itercost}, $$self{tokens}, $$self{dims});
push(@params, $self->physics->token) if defined $self->physics->token;
$$self{interp}->set_params([@params]);
return $self;
}
=head1 METHODS
=head2 invoke
my $rv = $critter->invoke($board);
lib/AI/Evolve/Befunge/Critter.pm view on Meta::CPAN
L</move> (see below), which handles exceptions properly.
=cut
sub invoke {
my ($self, $board) = @_;
delete($$self{move});
$self->populate($board) if defined $board;
my $rv = Result->new(name => $self->blueprint->name);
my $initial_ip = Language::Befunge::IP->new($$self{dims});
$initial_ip->set_position($$self{codeoffset});
my $interp = $self->interp;
push(@{$initial_ip->get_toss}, @{$interp->get_params});
$interp->set_ips([$initial_ip]);
while($self->tokens > 0) {
my $ip = shift @{$interp->get_ips()};
unless(defined($ip)) {
my @ips = @{$interp->get_newips};
last unless scalar @ips;
$ip = shift @ips;
$interp->set_ips([@ips]);
}
unless(defined $$ip{_ai_critter}) {
$$ip{_ai_critter} = $self;
weaken($$ip{_ai_critter});
}
last unless $self->spend($self->itercost);
$interp->set_curip($ip);
$interp->process_ip();
if(defined($$self{move})) {
debug("move made: " . $$self{move} . "\n");
$rv->choice( $$self{move} );
return $rv;
}
}
debug("play timeout\n");
return $rv;
}
lib/AI/Evolve/Befunge/Critter/Result.pm view on Meta::CPAN
over. Higher numbers mean the critter consumed fewer resources.
=item won
Integer value, true if the critter won (as determined by the Physics
engine).
=back
These values may be set using the accessors (like: $result->died(1) ),
or they may be initialized by the constructor (like:
Result->new(died => 1) ).
=cut
1;
lib/AI/Evolve/Befunge/Physics.pm view on Meta::CPAN
my ($self, $aref, $board) = @_;
my $usage = 'Usage: $physics->run_board_game([$critter1, $critter2], $board)';
croak($usage) unless ref($self) =~ /^AI::Evolve::Befunge::Physics/;
croak($usage) unless ref($board) eq 'AI::Evolve::Befunge::Board';
my ($critter1, $critter2) = @$aref;
croak($usage) unless ref($critter1) eq 'AI::Evolve::Befunge::Critter';
croak($usage) unless ref($critter2) eq 'AI::Evolve::Befunge::Critter';
croak($usage) if @$aref != 2;
croak($usage) if @_ > 3;
my $moves = 1;
$self->setup_board($board);
my @orig_players = ({critter => $critter1, stats => {pass => 0}},
{critter => $critter2, stats => {pass => 0}});
my @players = @orig_players;
# create a dummy Result object, just in case the loop never gets to player2
# (because player1 died on the first move).
$players[1]{rv} = Result->new(name => $critter2->blueprint->name, tokens => $critter2->tokens);
while(!$self->over($board)) {
my $rv = $players[0]{rv} = $players[0]{critter}->move($board, $players[0]{stats});
my $move = $rv->choice();
undef $move unless ref($move) eq 'Language::Befunge::Vector';
lib/AI/Evolve/Befunge/Physics.pm view on Meta::CPAN
$rv = ($rv1->tokens() <=> $rv2->tokens())*4 # or prefer more tokens
unless $rv;
$rv = ($rv2->died() <=> $rv1->died() )*2 # or prefer less dying
unless $rv;
$rv = ($rv2->name() cmp $rv1->name() )*1 # or prefer quieter names
unless $rv;
return $rv;
}
=head2 setup_and_run_board_game
my $score = $physics->setup_and_run_board_game($bp1, $bp2);
Creates Critter objects from the given Blueprint objects, creates a
game board (with board_size as determined from the physics plugin),
and calls run_board_game, above.
=cut
sub setup_and_run_board_game {
my ($self, $config, $bp1, $bp2) = @_;
my $usage = '...->setup_and_run($config, $blueprint1, $blueprint2)';
croak($usage) unless ref($config) eq 'AI::Evolve::Befunge::Util::Config';
croak($usage) unless ref($bp1) eq 'AI::Evolve::Befunge::Blueprint';
croak($usage) unless ref($bp2) eq 'AI::Evolve::Befunge::Blueprint';
my @extra_args;
push(@extra_args, Config => $config);
push(@extra_args, Physics => $self);
push(@extra_args, Commands => $$self{commands});
push(@extra_args, BoardSize => $self->board_size);
my $board = Board->new(Size => $self->board_size);
my $critter1 = Critter->new(Blueprint => $bp1, Color => 1, @extra_args);
lib/AI/Evolve/Befunge/Physics.pm view on Meta::CPAN
=cut
sub double_match :Export(:DEFAULT) {
my ($self, $config, $bp1, $bp2) = @_;
my $usage = '...->double_match($config, $blueprint1, $blueprint2)';
croak($usage) unless ref($config) eq 'AI::Evolve::Befunge::Util::Config';
croak($usage) unless ref($bp1) eq 'AI::Evolve::Befunge::Blueprint';
croak($usage) unless ref($bp2) eq 'AI::Evolve::Befunge::Blueprint';
my ($data1, $data2);
$data1 = $self->setup_and_run_board_game($config,$bp1,$bp2);
$data2 = $self->setup_and_run_board_game($config,$bp2,$bp1);
return ($data1 - $data2) <=> 0;
}
=head1 COMMAND CALLBACKS
These functions are intended for use as Befunge opcode handlers, and
are used by the Physics plugin modules.
=head2 op_make_board_move
lib/AI/Evolve/Befunge/Physics/othello.pm view on Meta::CPAN
AI::Evolve::Befunge::Physics::othello - an othello game
=head1 SYNOPSIS
my $physics = AI::Evolve::Befunge::Physics->new('othello');
=head1 DESCRIPTION
This is an implementation of the "othello" board game ruleset. This
game is also known to some as "reversi". It is implemented as a
plugin for the AI::Evolve::Befunge Physics system; essentially an AI
creature exists in an "othello" universe, and plays by its rules.
=head1 CONSTRUCTOR
Use AI::Evolve::Befunge::Physics->new() to get an othello object;
there is no constructor in this module for you to call directly.
=head1 METHODS
=head2 setup_board
$othello->setup_board($board);
Initialize the board to its default state. For othello, this looks
like:
........
........
........
...xo...
...ox...
........
........
........
=cut
sub setup_board {
my ($self, $board) = @_;
$board->clear();
$board->set_value(v(3, 3), 1);
$board->set_value(v(3, 4), 2);
$board->set_value(v(4, 3), 2);
$board->set_value(v(4, 4), 1);
}
=head2 in_bounds
die("out of bounds") unless $othello->in_bounds($vec);
Returns 1 if the vector is within the playspace, and 0 otherwise.
=cut
lib/AI/Evolve/Befunge/Physics/othello.pm view on Meta::CPAN
}
return $mine;
}
=head2 can_pass
my $can_pass = $othello->can_pass($board, $player);
Returns 1 if the player can pass, and 0 otherwise. For the othello
rule set, passing is only allowed if no valid moves are available.
=cut
sub can_pass {
my ($self,$board,$player) = @_;
my $possible_points = 0;
foreach my $y (0..7) {
foreach my $x (0..7) {
$possible_points += valid_move($self,$board,$player,v($x,$y));
}
lib/AI/Evolve/Befunge/Physics/othello.pm view on Meta::CPAN
sub make_move {
my ($self, $board, $player, $pos) = @_;
confess "make_move: player value '$player' out of range!" if $player < 1 or $player > 2;
confess "make_move: vector is undef!" unless defined $pos;
confess "make_move: vector '$pos' out of range!" unless $self->in_bounds($pos);
foreach my $vec (@valid_dirs) {
my $num = $self->try_move_vector($board,$player,$pos,$vec);
my $cur = $pos + $vec;
for(1..$num) {
$board->set_value($cur, $player);
$cur += $vec;
}
}
$board->set_value($pos, $player);
return 0 if $self->won($board); # game over, one of the players won
return 3-$player unless $self->can_pass($board,3-$player); # normal case, other player's turn
return $player unless $self->can_pass($board,$player); # player moves again
return 0; # game over, tie game
}
register_physics(
name => "othello",
token => ord('O'),
lib/AI/Evolve/Befunge/Physics/ttt.pm view on Meta::CPAN
AI::Evolve::Befunge::Physics::ttt - a tic tac toe game
=head1 SYNOPSIS
my $ttt = AI::Evolve::Befunge::Physics->new('ttt');
=head1 DESCRIPTION
This is an implementation of the "ttt" game ruleset. It is
implemented as a plugin for the AI::Evolve::Befunge Physics system;
essentially an AI creature exists in a "tic tac toe" universe,
and plays by its rules.
=head1 CONSTRUCTOR
Use AI::Evolve::Befunge::Physics->new() to get a ttt object;
there is no constructor in this module for you to call directly.
=head1 METHODS
=head2 setup_board
$ttt->setup_board($board);
Initialize the board to its default state. For tic tac toe, this
looks like:
...
...
...
=cut
sub setup_board {
my ($self, $board) = @_;
$board->clear();
}
=head2 valid_move
my $valid = $ttt->valid_move($board, $player, $pos);
Returns 1 if the move is valid, 0 otherwise. In tic tac toe, all
lib/AI/Evolve/Befunge/Physics/ttt.pm view on Meta::CPAN
$next_player = $ttt->make_move($board, $player, $pos)
if $ttt->valid_move($board, $player, $pos);
Makes the given move, updates the board with the newly placed piece.
=cut
sub make_move {
my ($self, $board, $player, $v) = @_;
confess("need a vector argument") unless ref($v) eq 'Language::Befunge::Vector';
$board->set_value($v, $player);
return 0 if $self->won($board);
return 0 if $self->over($board);
return 3 - $player; # 2 => 1, 1 => 2
}
register_physics(
name => "ttt",
token => ord('T'),
decorate => 0,
board_size => v(3, 3),
lib/AI/Evolve/Befunge/Population.pm view on Meta::CPAN
my $file = IO::File->new($savefile);
croak("cannot open file $savefile") unless defined $file;
while(my $line = $file->getline()) {
chomp $line;
if($line =~ /^generation=(\d+)/) {
# the savefile is the *result* of a generation number.
# therefore, we start at the following number.
$generation = $1 + 1;
} elsif($line =~ /^popid=(\d+)/) {
# and this tells us where to start assigning new critter ids from.
set_popid($1);
} elsif($line =~ /^\[/) {
push(@population, AI::Evolve::Befunge::Blueprint->new_from_string($line));
} else {
confess "unknown savefile line: $line\n";
}
}
my $self = bless({
host => $host,
blueprints => [@population],
generation => $generation,
lib/AI/Evolve/Befunge/Population.pm view on Meta::CPAN
=head2 fight
$population->fight();
Determines (through a series of fights) the basic fitness of each
critter in the population. The fight routine (see the "double_match"
method in Physics.pm) is called a bunch of times in parallel, and the
loser dies (is removed from the list). This is repeated until the total
population has been reduced to 25% of the "popsize" setting.
=cut
sub fight {
my $self = shift;
my $physics = $self->physics;
my $popsize = $self->popsize;
my $config = $self->config;
my $workers = $config->config("cpus", 1);
my @population = @{$self->blueprints};
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;
my $new_base = Language::Befunge::Vector->new_zeroes($nd);
my $old_base = $new_base->copy;
my $ones = Language::Befunge::Vector->new(map { 1 } (1..$nd));
my $old_offset = Language::Befunge::Vector->new(
map { int(rand()*2) } (1..$nd));
my $new_size = $old_size - $ones;
my $old_end = $old_size - $ones;
my $new_end = $new_size - $ones;
my $length = 1;
map { $length *= ($_) } ($new_size->get_all_components);
my $new_code = '';
my $old_code = $chromosome->code();
my $vec = Language::Befunge::Storage::Generic::Vec->new($nd, Wrapping => undef);
for(my $new_v = $new_base->copy(); defined($new_v); $new_v = $new_v->rasterize($new_base, $new_end)) {
my $old_v = $new_v + $old_offset;
my $old_offset = $vec->_offset($old_v, $new_base, $old_end);
my $new_offset = $vec->_offset($new_v, $new_base, $new_end);
$new_code .= substr($old_code, $old_offset, 1);
}
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
lib/AI/Evolve/Befunge/Population.pm view on Meta::CPAN
my $old_end = $old_size - $ones;
my $new_end = $new_base + $new_size - $ones;
my $length = 1;
map { $length *= ($_) } ($new_size->get_all_components);
return $chromosome if $length > $self->tokens;
my $new_code = ' ' x $length;
my $old_code = $chromosome->code();
my $vec = Language::Befunge::Storage::Generic::Vec->new($nd, Wrapping => undef);
for(my $old_v = $old_base->copy(); defined($old_v); $old_v = $old_v->rasterize($old_base, $old_end)) {
my $new_v = $old_v + $new_base;
my $old_offset = $vec->_offset($old_v, $old_base, $old_end);
my $new_offset = $vec->_offset($new_v, $new_base, $new_end);
substr($new_code, $new_offset, 1) = substr($old_code, $old_offset, 1);
}
return AI::Evolve::Befunge::Blueprint->new(code => $new_code, dimensions => $nd);
}
=head2 cleanup_intermediate_savefiles
$population->cleanup_intermediate_savefiles();
Keeps the results folder mostly clean. It preserves the milestone
lib/AI/Evolve/Befunge/Population.pm view on Meta::CPAN
$c2 = $population[$c2];
return ($c1, $c2);
}
=head2 generation
my $generation = $population->generation();
$population->generation(1000);
Fetches or sets the population's generation number to the given value.
The value should always be numeric.
When set, as a side effect, rehashes the config file so that new
generational overrides may take effect.
=cut
sub generation {
my ($self, $gen) = @_;
if(defined($gen)) {
$$self{generation} = $gen;
$self->reload_defaults();
}
lib/AI/Evolve/Befunge/Util.pm view on Meta::CPAN
print($val);
}
} else {
print(substr($code,$y*$sizex,$sizex));
}
printf("\n");
}
}
=head2 setup_configs
setup_configs();
Load the config files from disk, set up the various data structures
to allow fetching global and overrideable configs. This is called
internally by L</global_config> and L</custom_config>, so you never
have to call it directly.
=cut
my $loaded_config_before = 0;
my @all_configs = {};
my $global_config;
sub setup_configs {
return if $loaded_config_before;
my %global_config;
my @config_files = (
"/etc/ai-evolve-befunge.conf",
$ENV{HOME}."/.ai-evolve-befunge",
);
push(@config_files, $ENV{AIEVOLVEBEFUNGE}) if exists $ENV{AIEVOLVEBEFUNGE};
foreach my $config_file (@config_files) {
next unless -r $config_file;
push(@all_configs, LoadFile($config_file));
lib/AI/Evolve/Befunge/Util.pm view on Meta::CPAN
my @list = global_config('name', ['default1', 'default2']);
Fetch some config from the config file. This queries the global
config database - it will not take local overrides (for host,
generation, or physics plugin) into account. For more specific
(and flexible) config, see L</custom_config>, below.
=cut
sub global_config :Export(:DEFAULT) {
setup_configs();
return $global_config->config(@_);
}
=head2 custom_config
my $config = custom_config(host => $host, physics => $physics, gen => $gen);
my $value = $config('name');
my $value = $config('name', 'default');
my @list = $config('name', 'default');
lib/AI/Evolve/Befunge/Util.pm view on Meta::CPAN
Note that you can recurse these, but if you have two paths to the same
value, you should not rely on which one takes precedence. In other
words, if you have a "byhost" clause within a "bygen" section, and you
also have a "bygen" clause within a "byhost" section, either one may
eventually be used. When in doubt, simplify your config file.
=cut
sub custom_config :Export(:DEFAULT) {
my %args = @_;
setup_configs();
# deep copy
my @configs = Load(Dump(@all_configs));
my $redo = 1;
while($redo) {
$redo = 0;
foreach my $config (@configs) {
if(exists($args{host})) {
my $host = $args{host};
if(exists($$config{byhost}) && exists($$config{byhost}{$host})) {
t/02physics.t view on Meta::CPAN
# compare
is($test->compare(Result->new(won => 1), Result->new() ), 32, "compare won");
is($test->compare(Result->new(score => 1), Result->new() ), 16, "compare score");
is($test->compare(Result->new(moves => 1), Result->new() ), 8, "compare moves");
is($test->compare(Result->new(tokens => 1), Result->new() ), 4, "compare tokens");
is($test->compare(Result->new(), Result->new(died => 1) ), 2, "compare died");
is($test->compare(Result->new(name => 'a'), Result->new(name => 'b')), 1, "compare name");
BEGIN { $num_tests += 6 };
# setup_and_run
dies_ok(sub { $test->setup_and_run_board_game( ) }, "no config argument");
dies_ok(sub { $test->setup_and_run_board_game($config ) }, "no blueprint1 argument");
dies_ok(sub { $test->setup_and_run_board_game($config,$bplay1) }, "no blueprint2 argument");
BEGIN { $num_tests += 3 };
# double_match
dies_ok(sub { $test->double_match( ) }, "no config argument");
dies_ok(sub { $test->double_match($config ) }, "no blueprint1 argument");
dies_ok(sub { $test->double_match($config,$bplay1) }, "no blueprint2 argument");
BEGIN { $num_tests += 3 };
t/02physics.t view on Meta::CPAN
$score++;
}
}
}
return $score < 2;
}
sub make_move {
my ($self, $board, $player, $v) = @_;
confess("need a vector argument") unless ref($v) eq 'Language::Befunge::Vector';
$board->set_value($v, $player);
return 0 if $self->won($board);
return 0 if $self->over($board);
return 3 - $player; # 2 => 1, 1 => 2
}
sub setup_board {
my ($self, $board) = @_;
$board->clear();
}
BEGIN {
register_physics(
name => "test1",
board_size => v(2, 2),
commands => {
M => \&AI::Evolve::Befunge::Physics::op_make_board_move,
t/02physics.t view on Meta::CPAN
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 => "test2",
);};
t/04board.t view on Meta::CPAN
$size = v(0, 2);
dies_ok( sub { Board->new(Size => $size); }, "Board->new dies with zero-length side");
like($@, qr/must be at least 1/, "died with proper message");
$size = v(2, 2, 2);
dies_ok( sub { Board->new(Size => $size); }, "Board->new dies with dimensional overflow");
like($@, qr/isn't smart enough/, "died with proper message");
$size = v(2, 2, 1);
lives_ok( sub { Board->new(Size => $size); }, "Board->new makes an exception for d(2+) == 1");
BEGIN { $num_tests += 18 };
# set_value
# fetch_value
is($board->fetch_value(v(0,0)), 0, "default value is 0");
$board->set_value(v(2,2),2);
is($board->fetch_value(v(2,2)), 2, "fetch_value returns value set by set_value");
is($board->fetch_value(v(4,4)), 0, "default value is 0");
dies_ok( sub { $board->fetch_value(0) }, 'fetch_value with no vector');
dies_ok( sub { $board->set_value(0, 1) }, 'set_value with no vector');
dies_ok( sub { $board->fetch_value(v(-1,0)) }, 'fetch_value out of range');
like($@, qr/out of range/, "died with proper message");
dies_ok( sub { $board->fetch_value(v(5,0)) }, 'fetch_value out of range');
like($@, qr/out of range/, "died with proper message");
dies_ok( sub { $board->fetch_value(v(0,-1)) }, 'fetch_value out of range');
like($@, qr/out of range/, "died with proper message");
dies_ok( sub { $board->fetch_value(v(0,5)) }, 'fetch_value out of range');
like($@, qr/out of range/, "died with proper message");
dies_ok( sub { $board->set_value(v(-1,0), 1) }, 'set_value out of range');
like($@, qr/out of range/, "died with proper message");
dies_ok( sub { $board->set_value(v(5,0), 1) }, 'set_value out of range');
like($@, qr/out of range/, "died with proper message");
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);
is($board->fetch_value(v(2,2)), 2, "old copy has old values");
is($board->fetch_value(v(4,4)), 0, "old copy has old values");
is($board2->fetch_value(v(2,2)), 0, "new copy has new values");
is($board2->fetch_value(v(4,4)), 2, "new copy has new values");
$board->set_value(v(2,2),1);
$board->set_value(v(4,4),1);
is($board->fetch_value(v(2,2)), 1, "old copy has new values");
is($board->fetch_value(v(4,4)), 1, "old copy has new values");
is($board2->fetch_value(v(2,2)), 0, "new copy still has its own values");
is($board2->fetch_value(v(4,4)), 2, "new copy still has its own values");
BEGIN { $num_tests += 12 };
# clear
is($board->fetch_value(v(0,0)), 0, "board still has old values");
$board->clear();
is($board->fetch_value(v(2,2)), 0, "board has been cleared");
t/05critter.t view on Meta::CPAN
BEGIN { $ENV{AIEVOLVEBEFUNGE} = 't/insane.conf'; };
use aliased 'AI::Evolve::Befunge::Blueprint' => 'Blueprint';
use aliased 'AI::Evolve::Befunge::Critter' => 'Critter';
use AI::Evolve::Befunge::Util qw(v custom_config push_debug);
my $num_tests;
BEGIN { $num_tests = 0; };
# setup
my $ph = AI::Evolve::Befunge::Physics->new('test1');
my $bp = Blueprint->new(code => ' 'x256, dimensions => 4);
my $bp2 = Blueprint->new(code => " \n"x128, dimensions => 4);
my $config = custom_config();
# constructor
dies_ok(sub {Critter->new(Config => $config, Physics => $ph)}, "Critter->new dies without Blueprint");
like($@, qr/Usage: /, "died with usage message");
dies_ok(sub {Critter->new(Blueprint => $bp, Physics => $ph )}, "Critter->new dies without Config");
t/05critter.t view on Meta::CPAN
1983, # tokens
2, # itercost
1, # repeatcost
2, # stackcost
10, # threadcost
17, 17, # codesize
17, 17, # maxsize
5, 5, # boardsize,
];
$rv = newaebc('PPPPPPPPPPPPPPPPq', 17, 1);
is_deeply([reverse @{$rv->interp->get_params}], $stack_expectations, 'Critter constructor sets the params value correctly');
push(@$stack_expectations, 0, 0, 0); # make sure nothing else is on the stack
$rv = $rv->move();
ok(!$rv->died, "did not die");
is_deeply([@AI::Evolve::Befunge::Physics::test1::p], $stack_expectations, 'Critter adds lots of useful info to the initial stack');
@AI::Evolve::Befunge::Physics::test1::p = ();
$rv = newaebc('PPPPPPPPPPPPPPPPq', 17, 1)->move();
ok(!$rv->died, "did not die");
is_deeply([@AI::Evolve::Befunge::Physics::test1::p], $stack_expectations, 'Critter adds it EVERY time');
BEGIN { $num_tests += 5 };
t/05critter.t view on Meta::CPAN
my $ls = $befunge->get_storage;
lives_ok{$ls->expand(v(4, 4, 4, 4))} "expand bounds checking";
dies_ok {$ls->expand(v(4, 4, 4, 5))} "expand bounds checking";
like($@, qr/out of bounds/, "out of bounds detection");
dies_ok {$ls->expand(v(4, 4, 5, 4))} "expand bounds checking";
like($@, qr/out of bounds/, "out of bounds detection");
dies_ok {$ls->expand(v(4, 5, 4, 4))} "expand bounds checking";
like($@, qr/out of bounds/, "out of bounds detection");
dies_ok {$ls->expand(v(5, 4, 4, 4))} "expand bounds checking";
like($@, qr/out of bounds/, "out of bounds detection");
lives_ok{$ls->expand(v(-4,-4,-4,-4))} "set_min bounds checking";
dies_ok {$ls->expand(v(-4,-4,-4,-5))} "set_min bounds checking";
like($@, qr/out of bounds/, "out of bounds detection");
dies_ok {$ls->expand(v(-4,-4,-5,-4))} "set_min bounds checking";
like($@, qr/out of bounds/, "out of bounds detection");
dies_ok {$ls->expand(v(-4,-5,-4,-4))} "set_min bounds checking";
like($@, qr/out of bounds/, "out of bounds detection");
dies_ok {$ls->expand(v(-5,-4,-4,-4))} "set_min bounds checking";
like($@, qr/out of bounds/, "out of bounds detection");
BEGIN { $num_tests += 18 };
BEGIN { plan tests => $num_tests };
package AI::Evolve::Befunge::Physics::test1;
use strict;
use warnings;
t/05critter.t view on Meta::CPAN
use base 'AI::Evolve::Befunge::Physics';
use AI::Evolve::Befunge::Physics qw(register_physics);
use AI::Evolve::Befunge::Util qw(v);
sub new {
my $package = shift;
return bless({}, $package);
}
sub setup_board {
my ($self, $board) = @_;
$board->clear();
}
sub valid_move {
my ($self, $board, $player, $x, $y) = @_;
return 0 if $board->fetch_value($x, $y);
return 1;
}
t/05critter.t view on Meta::CPAN
sub over { return 0; }
sub score { return 0; }
sub make_move {
my ($self, $board, $player, $x, $y) = @_;
confess "make_move: player value '$player' out of range!" if $player < 1 or $player > 2;
confess "make_move: x value is undef!" unless defined $x;
confess "make_move: y value is undef!" unless defined $y;
confess "make_move: x value '$x' out of range!" if $x < 0 or $x >= $$board{sizex};
confess "make_move: y value '$y' out of range!" if $y < 0 or $y >= $$board{sizey};
$board->set_value($x, $y, $player);
return 0 if $self->won($board); # game over, one of the players won
return 3-$player;
}
BEGIN {
register_physics(
name => "test1",
token => ord('P'),
board_size => v(5, 5),
commands => {
t/07physics_ttt.t view on Meta::CPAN
is($ttt->score($board, 2, 9), 10, "tie game");
$$board{b} = [
[1, 2, 1],
[2, 0, 2],
[2, 1, 2],
];
is($ttt->make_move($board,1,v(1,1)), 0, "draw game = game over");
BEGIN { $num_tests += 6 };
# setup_board
$ttt->setup_board($board);
is($board->as_string, <<EOF, "empty board");
...
...
...
EOF
BEGIN { $num_tests += 1 };
BEGIN { plan tests => $num_tests };
t/08physics_othello.t view on Meta::CPAN
my $num_tests;
BEGIN { $num_tests = 0; };
# basic game
# try to create an othello object
my $othello = Physics->new('othello');
ok(ref($othello) eq "AI::Evolve::Befunge::Physics::othello", "create an othello object");
BEGIN { $num_tests += 1 };
# setup_board
my $board = Board->new(Size => 8, Dimensions => 2);
$othello->setup_board($board);
is($board->as_string, <<EOF, 'setup_board initial values');
........
........
........
...xo...
...ox...
........
........
........
EOF
BEGIN { $num_tests += 1 };
t/09population.t view on Meta::CPAN
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');
t/09population.t view on Meta::CPAN
"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
# 4**4 = 256
# 5**4 = 625
t/09population.t view on Meta::CPAN
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');
t/09population.t view on Meta::CPAN
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",
);};
tools/evolve view on Meta::CPAN
=head1 SYNOPSIS
evolve [-q|v|d] [-h host] [savefile]
=head1 DESCRIPTION
This script is a frontend to the AI::Evolve::Befunge genetic
algorithm. It sets up a board game instance, possibly loading
previous genetic data from a savefile (if given on the command line),
and starts running a new generation.
It will run until it is killed.
=head1 COMMAND LINE ARGUMENTS
=head2 -q, --quiet
( run in 1.378 second using v1.01-cache-2.11-cpan-49f99fa48dc )