AI-Evolve-Befunge
view release on metacpan or search on metacpan
lib/AI/Evolve/Befunge.pm view on Meta::CPAN
want it to do.
If you don't know anything about Befunge, I recommend you read up on
that first, before trying to understand how this works.
The individuals of this population (which we call Critters) may be of
various sizes, and may make heavy or light use of threads and stacks.
Each one is issued a certain number of "tokens" (which you can think
of as blood sugar or battery power). Just being born takes a certain
number of tokens, depending on the code size. After that, doing things
(like executing a befunge command, pushing a value to the stack,
spawning a thread) all take a certain number of tokens to accomplish.
When the number of tokens drops to 0, the critter dies. So it had
better accomplish its task before that happens.
After a population fights it out for a while, the winners are chosen
(who continue to live) and everyone else dies. Then a new population
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
lib/AI/Evolve/Befunge/Critter.pm view on Meta::CPAN
the board data segment is refreshed each time.
=head1 LIMITS
This execution environment is sandboxed. Every attempt is made to
keep the code under test from escaping the environment, or consuming
an unacceptable amount of resources.
Escape is prevented by disabling all file operations, I/O operations,
system commands like fork() and system(), and commands which load
(potentially insecure) external Befunge semantics modules.
Resource consumption is limited through the use of a currency system.
The way this works is, each critter starts out with a certain amount
of "Tokens" (the critter form of currency), and every action (like an
executed befunge instruction, a repeated command, a spawned thread,
etc) incurs a cost. When the number of tokens drops to 0, the critter
dies. This prevents the critter from getting itself (and the rest of
the system) into trouble.
For reference, the following things are specifically tested for:
=over 4
=item Size of stacks
=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
hash:
, (Output Character)
. (Output Integer)
~ (Input Character)
& (Input Integer)
i (Input File)
o (Output File)
= (Execute)
( (Load Semantics)
lib/AI/Evolve/Befunge/Critter.pm view on Meta::CPAN
that means the critter pays 512 tokens just to be born. If CodeCost
is 2, the critter pays 1024 tokens, and so on.
If not specified, this will be pulled from the variable "codecost" in
the config file. If that can't be found, a default value of 1 is
used.
=item IterCost
This is the number of tokens the critter pays for each command it
runs. It is a basic operational overhead, decremented for each clock
tick for each running thread.
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
lib/AI/Evolve/Befunge/Critter.pm view on Meta::CPAN
in the config file. If that can't be found, a default value of 1 is
used.
=item ThreadCost
This is a fixed number of tokens the critter pays for spawning a new
thread. When a new thread is created, this cost is incurred, plus the
cost of duplicating all of the thread's stacks (see StackCost, above).
The new threads will begin incurring additional costs from the
IterCost (also above), when it begins executing commands of its own.
If not specified, this will be pulled from the variable "threadcost"
in the config file. If that can't be found, a default value of 10 is
used.
=item Color
This determines the color of the player, which (for board games)
indicates which type of piece the current player is able to play. It
lib/AI/Evolve/Befunge/Critter.pm view on Meta::CPAN
$$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};
# store a copy of the Critter in the storage, so _expand (below) can adjust
# the remaining tokens.
$$storage{_ai_critter} = $self;
weaken($$storage{_ai_critter});
# store a copy of the Critter in the interp, so various command callbacks
# (below) can adjust the remaining tokens.
$$interp{_ai_critter} = $self;
weaken($$interp{_ai_critter});
$interp->get_ops->{'{'} = \&AI::Evolve::Befunge::Critter::_block_open;
$interp->get_ops->{'j'} = \&AI::Evolve::Befunge::Critter::_op_flow_jump_to_wrap;
$interp->get_ops->{'k'} = \&AI::Evolve::Befunge::Critter::_op_flow_repeat_wrap;
$interp->get_ops->{'t'} = \&AI::Evolve::Befunge::Critter::_op_spawn_ip_wrap;
my @invalid_meths = (',','.','&','~','i','o','=','(',')',map { chr } (ord('A')..ord('Z')));
$$self{interp}{ops}{$_} = $$self{interp}{ops}{r} foreach @invalid_meths;
if(exists($args{Commands})) {
foreach my $command (sort keys %{$args{Commands}}) {
my $cb = $args{Commands}{$command};
$$self{interp}{ops}{$command} = $cb;
}
}
my @params;
my @vectors;
push(@vectors, $$self{boardsize}) if exists $$self{boardsize};
push(@vectors, $$self{maxsize}, $$self{codesize});
foreach my $vec (@vectors) {
push(@params, $vec->get_all_components());
lib/AI/Evolve/Befunge/Physics.pm view on Meta::CPAN
use Carp;
use Perl6::Export::Attrs;
use UNIVERSAL::require;
use AI::Evolve::Befunge::Util;
use aliased 'AI::Evolve::Befunge::Board' => 'Board';
use aliased 'AI::Evolve::Befunge::Critter' => 'Critter';
use aliased 'AI::Evolve::Befunge::Critter::Result' => 'Result';
use base 'Class::Accessor::Fast';
__PACKAGE__->mk_accessors( qw{ name board_size commands token decorate generations } );
# FIXME: this module needs some extra codepaths to handle non-boardgame Physics
# engines.
=head1 NAME
AI::Evolve::Befunge::Physics - Physics engine base class
=head1 SYNOPSIS
For a rules plugin (game or application):
register_physics(
name => "ttt",
token => ord('T'),
decorate => 0.
board_size => Language::Befunge::Vector->new(3, 3),
commands => { M => \&AI::Evolve::Befunge::Physics::op_board_make_move },
);
For everyone else:
$ttt = Physics->new('ttt');
my $score = $ttt->double_match($blueprint1, $blueprint2);
=head1 DESCRIPTION
lib/AI/Evolve/Befunge/Physics.pm view on Meta::CPAN
=head1 STANDALONE FUNCTIONS
=head2 register_physics
register_physics(
name => "ttt",
token => ord('T'),
decorate => 0.
board_size => Language::Befunge::Vector->new(3, 3),
commands => { M => \&AI::Evolve::Befunge::Physics::op_board_make_move },
);
Create a new physics plugin, and register it with the Physics plugin
database. The "name" passed here can be used later on in ->new()
(see below) to fetch an instance of that physics plugin.
The arguments are:
name: The name of the Physics module. Used by Physics->new
to fetch the right plugin.
token: A unique numeric token representing this Physics
plugin. It is possible that a Critter could evolve
that can function usefully in more than one universe;
this token is pushed onto its initial stack in order
to encourage this.
decorate: Used by graphical frontends. If non-zero, the
graphical frontend will use special icons to indicate
spaces where a player may move.
commands: A hash of op callback functions, indexed on the
Befunge character that should call them.
board_size: A Vector denoting the size of a game's board. This
field is optional; non-game plugins should leave it
unspecified.
=cut
{ my %rules;
lib/AI/Evolve/Befunge/Physics.pm view on Meta::CPAN
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);
my $critter2 = Critter->new(Blueprint => $bp2, Color => 2, @extra_args);
return $self->run_board_game([$critter1,$critter2], $board);
}
=head2 double_match
lib/AI/Evolve/Befunge/Physics/othello.pm view on Meta::CPAN
return $player unless $self->can_pass($board,$player); # player moves again
return 0; # game over, tie game
}
register_physics(
name => "othello",
token => ord('O'),
decorate => 1,
board_size => v(8, 8),
commands => {
M => \&AI::Evolve::Befunge::Physics::op_make_board_move,
T => \&AI::Evolve::Befunge::Physics::op_query_tokens
},
);
1;
lib/AI/Evolve/Befunge/Physics/ttt.pm view on Meta::CPAN
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),
commands => {
M => \&AI::Evolve::Befunge::Physics::op_make_board_move,
T => \&AI::Evolve::Befunge::Physics::op_query_tokens
},
);
1;
lib/AI/Evolve/Befunge/Population.pm view on Meta::CPAN
my ($self, $length, $density) = @_;
my @safe = ('0'..'9', 'a'..'h', 'j'..'n', 'p'..'z', '{', '}', '`', '_',
'!', '|', '?', '<', '>', '^', '[', ']', ';', '@', '#', '+',
'/', '*', '%', '-', ':', '$', '\\' ,'"' ,"'");
my $usage = 'Usage: $population->new_code_fragment($length, $density);';
croak($usage) unless ref($self);
croak($usage) unless defined($length);
croak($usage) unless defined($density);
my $physics = $self->physics;
push(@safe, sort keys %{$$physics{commands}})
if exists $$physics{commands};
my $rv = '';
foreach my $i (1..$length) {
my $chr = ' ';
if(rand()*100 < $density) {
$chr = $safe[int(rand()*(scalar @safe))];
}
$rv .= $chr;
}
return $rv;
}
t/02physics.t view on Meta::CPAN
my $tier1 = "00M["
."M10]" . (" "x8);
my $tier2 = "10M["
."M11]" . (" "x8);
my $bpart1 = Blueprint->new(code => $part1, dimensions => 2);
my $bplay1 = Blueprint->new(code => $play1, dimensions => 2);
my $bdier1 = Blueprint->new(code => $dier1, dimensions => 2);
my $btier1 = Blueprint->new(code => $tier1, dimensions => 2);
my $btier2 = Blueprint->new(code => $tier2, dimensions => 2);
my $board = Board->new(Size => 2, Dimensions => 2);
my $cpart1 = Critter->new(Blueprint => $bpart1, BoardSize => $board->size, Color => 1, Physics => $test, Commands => $$test{commands}, Config => $config);
my $cplay1 = Critter->new(Blueprint => $bplay1, BoardSize => $board->size, Color => 2, Physics => $test, Commands => $$test{commands}, Config => $config);
my $cdier1 = Critter->new(Blueprint => $bdier1, BoardSize => $board->size, Color => 1, Physics => $test, Commands => $$test{commands}, Config => $config);
my $ctier1 = Critter->new(Blueprint => $btier1, BoardSize => $board->size, Color => 1, Physics => $test, Commands => $$test{commands}, Config => $config);
my $ctier2 = Critter->new(Blueprint => $btier2, BoardSize => $board->size, Color => 2, Physics => $test, Commands => $$test{commands}, Config => $config);
dies_ok(sub { AI::Evolve::Befunge::Physics::run_board_game }, "no self");
dies_ok(sub { $test->run_board_game() }, "no board");
dies_ok(sub { $test->run_board_game([], $board) }, "no critters");
dies_ok(sub { $test->run_board_game([$cpart1], $board) }, "too few critters");
dies_ok(sub { $test->run_board_game([$cpart1, $cplay1, $cplay1], $board ) }, "too many critters");
dies_ok(sub { $test->run_board_game([$cpart1, $cplay1], $board, $cplay1 ) }, "too many args");
lives_ok(sub{ $test->run_board_game([$cpart1, $cplay1], $board ) }, "a proper game was played");
$$test{passable} = 0;
push_debug(1);
stdout_like(sub{ $test->run_board_game([$cdier1, $cplay1], $board ) },
t/02physics.t view on Meta::CPAN
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 => \&AI::Evolve::Befunge::Physics::op_query_tokens
},
passable => 1,
);
@possible_wins = (
[v(0,0), v(1,1)],
[v(1,0), v(0,1)],
);
};
t/05critter.t view on Meta::CPAN
IterPerTurn => 100,
);
$rv = $critter->move();
ok($rv->died, "critter died");
like($rv->fate, qr/infinite loop/, "infinite loop is detected");
$critter = Critter->new(
Blueprint => $bp,
Physics => $ph,
Config => $config,
Commands => AI::Evolve::Befunge::Physics::find_physics("test1")->{commands},
);
BEGIN { $num_tests += 6 };
# Critter's nerfed Language::Befunge interpreter
ok(exists($$critter{interp}{ops}{'+'}), "Language::Befunge loaded");
foreach my $op (',','.','&','~','i','o','=','(',')') {
is($$critter{interp}{ops}{$op}, $$critter{interp}{ops}{r}, "operator $op got removed");
}
BEGIN { $num_tests += 10 };
foreach my $op ('+','-','1','2','3','<','>','[',']') {
isnt($$critter{interp}{ops}{$op}, $$critter{interp}{ops}{r}, "operator $op wasn't removed");
}
BEGIN { $num_tests += 9 };
# Critter adds extra commands specified by physics engine
is($$critter{interp}{ops}{T},
AI::Evolve::Befunge::Physics::find_physics("test1")->{commands}{T},
"'Test' command added");
is ($$critter{interp}{ops}{M}, $$critter{interp}{ops}{r}, "'Move' command not added");
BEGIN { $num_tests += 2 };
sub newaebc {
my ($code, $fullsize, $nd, @extra) = @_;
$code .= ' 'x($fullsize-length($code)) if length($code) < $fullsize;
my $bp = Blueprint->new(code => $code, dimensions => $nd);
push(@extra, BoardSize => $ph->board_size) if defined $ph->board_size;
my $rv = Critter->new(Blueprint => $bp, Config => $config, Physics => $ph,
Commands => AI::Evolve::Befunge::Physics::find_physics("test1")->{commands},
@extra);
return $rv;
}
# Critter adds lots of useful info to the initial IP's stack
my $stack_expectations =
[ord('P'), # physics plugin
2, # dimensions
1983, # tokens
t/05critter.t view on Meta::CPAN
$rv = newaebc("tq", 2, 1, Tokens => 50, ThreadCost => 10);
$rv = $rv->move();
is($rv->tokens, 8, '_op_spawn_ip_wrap decremented the proper amount');
ok(!$rv->died, "did not die");
$rv = newaebc("tq", 2, 1, Tokens => 10, ThreadCost => 10)->move();
is($rv->tokens, 4, '_op_spawn_ip_wrap bounced');
ok(!$rv->died, "did not die");
BEGIN { $num_tests += 4 };
# as a side effect, this also verifies that M, a non-defined command,
# acts like "r" (reverse).
is($AI::Evolve::Befunge::Physics::test1::t, 0, "T command not called before");
$rv = newaebc("1T1MqT5", 7, 1, Tokens => 50)->move();
ok(!$rv->died, "did not die");
is($AI::Evolve::Befunge::Physics::test1::t, 7, "T command had expected effect");
BEGIN { $num_tests += 3 };
my $befunge = $$critter{interp};
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");
t/05critter.t view on Meta::CPAN
$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 => sub { my $i = shift; my $j = $i->get_curip->spop; $t += $j },
P => sub { my $i = shift; my $j = $i->get_curip->spop; push(@p, $j) },
},
);
};
1;
t/09population.t view on Meta::CPAN
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);
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
Enable quiet mode. This will reduce the amount of output.
tools/evolve view on Meta::CPAN
=head2 -d, --debug
Enable debug mode. This will increase the amount of output.
=head2 -h <hostname>, --hostname=<hostname>
Set the hostname to the specified value. The default is to use the
output of the "hostname" shell command.
=head2 <savefile>
If specified, previous genetic data is read from this file. You can
easily "fork" an existing population on a new host by reading its
savefile.
=cut
# default command line options
my $debug = 0;
my $quiet = 0;
my $verbose = 0;
my $help = 0;
my $hostname = undef;
die("Usage: $0 [-q|v|d] [-h host] [-c num] [savefile]\n") unless GetOptions(
'debug' => \$debug,
'quiet' => \$quiet,
'verbose' => \$verbose,
tools/migrationd view on Meta::CPAN
=cut
=head2 -d, --debug
Enable debug mode. This will increase the amount of output.
=cut
# default command line options
my $quiet = 0;
my $verbose = 0;
my $debug = 0;
my $help = 0;
my $host = '0.0.0.0';
my $port = 29522;
die("Usage: $0 [-q|v|d] [-h host] [-p port]\n") unless GetOptions(
'debug' => \$debug,
'quiet' => \$quiet,
( run in 2.045 seconds using v1.01-cache-2.11-cpan-d8267643d1d )