comma results from the CPAN

comma

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.061 seconds using v1.01-cache-2.11-cpan-d8267643d1d )