AI-Evolve-Befunge
view release on metacpan or search on metacpan
lib/AI/Evolve/Befunge/Critter.pm view on Meta::CPAN
$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;
}
=head2 move
my $rv = $critter->move($board, $score);
Similar to invoke(), above. This function wraps invoke() in an
eval block, updates a scoreboard afterwards, and creates a "dead"
lib/AI/Evolve/Befunge/Critter.pm view on Meta::CPAN
=cut
sub move {
my ($self, $board) = @_;
my $rv;
local $@ = '';
eval {
$rv = $self->invoke($board);
};
if($@ ne '') {
debug("eval error $@\n");
$rv = Result->new(name => $self->blueprint->name, died => 1);
my $reason = $@;
chomp $reason;
$rv->fate($reason);
}
$rv->tokens($self->tokens);
return $rv;
}
lib/AI/Evolve/Befunge/Critter.pm view on Meta::CPAN
Attempts to spend a certain amount of the critter's tokens. Returns
true on success, false on failure.
=cut
sub spend {
my ($self, $cost) = @_;
$cost = int($cost);
my $tokens = $self->tokens - $cost;
#debug("spend: cost=$cost resulting tokens=$tokens\n");
return 0 if $tokens < 0;
$self->tokens($tokens);
return 1;
}
# sandboxing stuff
{
no warnings 'redefine';
lib/AI/Evolve/Befunge/Migrator.pm view on Meta::CPAN
my $select = IO::Select->new($$self{loc});
$select->add($$self{sock}) if defined $$self{sock};
my @sockets = $select->can_read(2);
foreach my $socket (@sockets) {
if($socket == $$self{loc}) {
my $rv = $socket->sysread($$self{txbuf}, 4096, length($$self{txbuf}));
$$self{dead} = 1 unless $rv;
} else {
my $rv = $socket->sysread($$self{rxbuf}, 4096, length($$self{rxbuf}));
if(!defined($rv) || $rv < 0) {
debug("Migrator: closing socket due to read error: $!\n");
undef $$self{sock};
next;
}
if(!$rv) {
debug("Migrator: closing socket due to EOF\n");
undef $$self{sock};
}
}
}
}
=head2 spin_writes
$migrator->spin_writes();
lib/AI/Evolve/Befunge/Migrator.pm view on Meta::CPAN
my $select = IO::Select->new();
$select->add($$self{loc}) if length $$self{rxbuf};
$select->add($$self{sock}) if(length $$self{txbuf} && defined($$self{sock}));
my @sockets = $select->can_write(0);
foreach my $socket (@sockets) {
if($socket == $$self{loc}) {
my $rv = $socket->syswrite($$self{rxbuf}, length($$self{rxbuf}));
if($rv > 0) {
substr($$self{rxbuf}, 0, $rv, '');
}
debug("Migrator: write on loc socket reported error $!\n") if($rv < 0);
}
if($socket == $$self{sock}) {
my $rv = $socket->syswrite($$self{txbuf}, length($$self{txbuf}));
if(!defined($rv)) {
debug("Migrator: closing socket due to undefined syswrite retval\n");
undef $$self{sock};
next;
}
if($rv > 0) {
substr($$self{txbuf}, 0, $rv, '');
}
if($rv < 0) {
debug("Migrator: closing socket due to write error $!\n");
undef $$self{sock};
}
}
}
}
=head2 spin_exceptions
$migrator->spin_exceptions();
lib/AI/Evolve/Befunge/Migrator.pm view on Meta::CPAN
=cut
sub spin_exceptions {
my $self = shift;
my $select = IO::Select->new();
$select->add($$self{loc});
$select->add($$self{sock}) if defined($$self{sock});
my @sockets = $select->has_exception(0);
foreach my $socket (@sockets) {
if($socket == $$self{loc}) {
debug("Migrator: dying: select exception on loc socket\n");
$$self{dead} = 1;
}
if($socket == $$self{sock}) {
debug("Migrator: closing socket due to select exception\n");
undef $$self{sock};
}
}
}
=head2 alive
exit unless $migrator->alive();
lib/AI/Evolve/Befunge/Migrator.pm view on Meta::CPAN
=cut
sub try_connect {
my $self = shift;
my $host = $$self{host};
my $port = $$self{port};
my $last = $$self{lastc};
return if $last > (time() - 2);
return if $$self{dead};
debug("Migrator: attempting to connect to $host:$port\n");
$$self{lastc} = time();
$$self{sock} = IO::Socket::INET->new(
Proto => 'tcp',
PeerAddr => $host,
PeerPort => $port,
Blocking => 0,
);
}
lib/AI/Evolve/Befunge/Population.pm view on Meta::CPAN
=cut
sub migrate_export {
my ($self) = @_;
$$self{migrate}->blocking(1);
# export some critters
for my $id (0..(rand(13)-10)) {
my $cid = ${$self->blueprints}[$id]{id};
$$self{migrate}->print(${$self->blueprints}[$id]->as_string);
debug("exporting critter $cid\n");
}
}
=head2 migrate_import
$population->migrate_import();
Look on the migration network for incoming critters, and import some
if we have room left. To prevent getting swamped, it will only allow
lib/AI/Evolve/Befunge/Population.pm view on Meta::CPAN
my @new;
my $select = IO::Select->new($$self{migrate});
if($select->can_read(0)) {
my $data;
$$self{migrate}->blocking(0);
$$self{migrate}->sysread($data, 10000);
my $in;
while(((scalar @{$self->blueprints} + scalar @new) < $critter_limit)
&& (($in = index($data, "\n")) > -1)) {
my $line = substr($data, 0, $in+1, '');
debug("migrate: importing critter\n");
my $individual =
AI::Evolve::Befunge::Blueprint->new_from_string($line);
push(@new, $individual) if defined $individual;
}
}
$self->blueprints([@{$self->blueprints}, @new])
if scalar @new;
}
lib/AI/Evolve/Befunge/Util.pm view on Meta::CPAN
use YAML qw(LoadFile Load Dump);
use aliased 'AI::Evolve::Befunge::Util::Config' => 'Config';
$ENV{HOST} = global_config("hostname", `hostname`);
$ENV{HOST} = "unknown-host-$$-" . int rand 65536 unless defined $ENV{HOST};
chomp $ENV{HOST};
my @quiet = 0;
my @verbose = 0;
my @debug = 0;
=head1 NAME
AI::Evolve::Befunge::Util - common utility functions
=head1 DESCRIPTION
This is a place for miscellaneous stuff that is used elsewhere
lib/AI/Evolve/Befunge/Util.pm view on Meta::CPAN
Returns the topmost entry on the "verbose" stack.
=cut
sub get_verbose :Export(:DEFAULT) {
return $verbose[-1];
}
=head2 push_debug
push_debug(1);
Add a new value to the "debug" stack.
=cut
sub push_debug :Export(:DEFAULT) {
my $new = shift;
push(@debug, $new);
}
=head2 pop_debug
pop_debug();
Remove the topmost entry from the "debug" stack, if more than one
item exists on the stack.
=cut
sub pop_debug :Export(:DEFAULT) {
my $new = shift;
pop(@debug) if @debug > 1;
}
=head2 get_debug
$quiet = get_debug();
Returns the topmost entry on the "debug" stack.
=cut
sub get_debug :Export(:DEFAULT) {
return $debug[-1];
}
=head2 verbose
verbose("Hi! I'm in verbose mode!\n");
Output a message if get_verbose() is true.
=cut
sub verbose :Export(:DEFAULT) {
print(@_) if $verbose[-1];
}
=head2 debug
verbose("Hi! I'm in debug mode!\n");
Output a message if get_debug() is true.
=cut
sub debug :Export(:DEFAULT) {
print(@_) if $debug[-1];
}
=head2 quiet
quiet("Hi! I'm in quiet mode!\n");
Output a message if get_quiet() is true. Note that this probably
isn't very useful.
t/02physics.t view on Meta::CPAN
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 ) },
qr/STDIN \(-4,-4\): infinite loop/,
"killed with an infinite loop error");
pop_debug();
lives_ok(sub{ $test->run_board_game([$ctier1, $ctier2], $board) }, "a proper game was played");
lives_ok(sub{ $test->run_board_game([$cpart1, $cpart1], $board) }, "a tie game was played");
push_quiet(0);
stdout_is(sub { $test->run_board_game([$cplay1, $cpart1], $board) }, <<EOF, "outputs board");
01
0 o.
1 ..
EOF
pop_quiet();
BEGIN { $num_tests += 11 };
t/05critter.t view on Meta::CPAN
#!/usr/bin/perl
use strict;
use warnings;
use Test::More;
use Test::Exception;
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();
push_verbose(3);
is(get_verbose(), 3, "verbose now");
stdout_is(sub { verbose("foo") }, "foo", "verbose() writes when verbose value non-zero");
pop_verbose();
pop_verbose();
is(get_verbose(), 0, "now back to non-verbose default");
stdout_is(sub { verbose("foo") }, "", "verbose() writes nothing");
BEGIN { $num_tests += 5 };
# debug
is(get_debug(), 0, "non-debug by default");
push_debug(3);
is(get_debug(), 3, "debug now");
stdout_is(sub { debug("foo") }, "foo", "debug() writes when debug value non-zero");
pop_debug();
pop_debug();
is(get_debug(), 0, "now back to non-debug default");
stdout_is(sub { debug("foo") }, "", "debug() writes nothing");
BEGIN { $num_tests += 5 };
# v
is(v(1, 2, 3), "(1,2,3)", "v returns a vector");
is(ref(v(1, 2, 3)), "Language::Befunge::Vector", "v the right kind of object");
BEGIN { $num_tests += 2 };
# code_print
tools/evolve view on Meta::CPAN
=head2 -q, --quiet
Enable quiet mode. This will reduce the amount of output.
=head2 -v, --verbose
Enable verbose mode. This will increase the amount of output.
=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,
'help' => \$help,
'hostname=s' => \$hostname,
);
exec("perldoc $0") if $help;
my $savefile = shift;
push_debug ($debug);
push_quiet ($quiet);
push_verbose($verbose);
my %population_args;
$population_args{Host} = "$hostname" if defined $hostname;
my $population;
if(defined($savefile)) {
$population = Population->load($savefile);
tools/migrationd view on Meta::CPAN
Enable quiet mode. This will reduce the amount of output.
=head2 -v, --verbose
Enable verbose mode. This will increase the amount of output.
=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,
'verbose' => \$verbose,
'help' => \$help,
'host=s' => \$host,
'port=i' => \$port,
);
exec("perldoc $0") if $help;
push_quiet($quiet);
push_verbose($verbose);
push_debug($debug);
verbose("opening socket\n");
my $listener = IO::Socket::INET->new(
Proto => 'tcp',
Listen => 1,
LocalHost => $host,
LocalPort => $port,
ReuseAddr => 1,
);
tools/migrationd view on Meta::CPAN
my $select = IO::Select->new($listener);
while(1) {
my @handles = $select->can_read(1);
foreach my $handle (@handles) {
if($handle == $listener) {
my $new = $listener->accept();
$new->blocking(0);
$select->add($new);
if($debug) {
my ($port, $ip) = sockaddr_in($new->peername);
$ip = inet_ntoa($ip);
debug("New connection from $ip:$port\n");
}
} else {
my $data = '';
$handle->recv($data, 100000, 0);
if(length($data)) {
$data =~ s/\r/\n/g; # turn CRs into LFs
$data =~ s/\n\n/\n/g; # remove redundant LFs
my $linesize;
while(($linesize = index($data, "\n")) > -1) {
my $line = substr($data, 0, $linesize+1, '');
if($debug) {
my ($port, $ip) = sockaddr_in($handle->peername);
$ip = inet_ntoa($ip);
debug("line from $ip:$port: $line");
}
foreach my $recipient ($select->handles) {
next if $recipient == $listener;
next if $recipient == $handle;
$recipient->send($line, 0);
}
}
} else {
if($debug) {
my ($port, $ip) = sockaddr_in($handle->peername);
$ip = inet_ntoa($ip);
debug("closing connection from $ip:$port due to EOF\n");
}
$select->remove($handle);
}
}
}
@handles = $select->has_exception(0);
foreach my $handle (@handles) {
die("exception on listener socket\n") if $handle == $listener;
if($debug) {
my ($port, $ip) = sockaddr_in($handle->peername);
$ip = inet_ntoa($ip);
debug("closing connection from $ip:$port due to exception\n");
}
$select->remove($handle);
}
}
( run in 1.557 second using v1.01-cache-2.11-cpan-49f99fa48dc )