AI-Evolve-Befunge

 view release on metacpan or  search on metacpan

lib/AI/Evolve/Befunge/Blueprint.pm  view on Meta::CPAN

Other arguments are optional, and will be determined automatically if
not specified:

    fitness - assign it a fitness score, default is 0.
    id - assign it an id, default is to call new_popid() (see below).
    host - the hostname, default is $ENV{HOST}.

=cut

sub new {
    my $self = bless({}, shift);
    my %args = @_;
    my $usage = 'Usage: AI::Evolve::Befunge::Blueprint->new(code => "whatever", dimensions => 4, [, id => 2, host => "localhost", fitness => 5]);\n';
    croak $usage unless exists $args{code};
    croak $usage unless exists $args{dimensions};
    $$self{code}      = $args{code};
    $$self{dims}      = $args{dimensions};
    if($$self{dims} > 1) {
        $$self{size}      = int((length($$self{code})+1)**(1/$$self{dims}));
    } else {
        $$self{size} = length($$self{code});

lib/AI/Evolve/Befunge/Board.pm  view on Meta::CPAN

most likely number of dimensions).  If the Size argument is numeric, the
Dimensions argument is required, and a size vector will be generated
internally.

=cut

# FIXME: fully vectorize this, and make this module dimensionality-independent
# (maybe just use another laheyspace for the storage object)

sub new {
    my $self = bless({}, shift);
    my %args = @_;
    my $usage = "\nUsage: ...Board->new(Dimensions => 4, Size => 8) or ...Board->new(Size => \$vector)";
    croak($usage) unless exists $args{Size};
    if(ref($args{Size})) {
        if(exists($args{Dimensions})) {
            croak "Dimensions argument doesn't match the number of dimensions in the vector"
                unless $args{Size}->get_dims() == $args{Dimensions};
        } else {
            $args{Dimensions} = $args{Size}->get_dims();
        }

lib/AI/Evolve/Befunge/Critter.pm  view on Meta::CPAN

    croak "CodeCost must be greater than 0!"   unless $args{CodeCost}   > 0;
    croak "IterCost must be greater than 0!"   unless $args{IterCost}   > 0;
    croak "RepeatCost must be greater than 0!" unless $args{RepeatCost} > 0;
    croak "StackCost must be greater than 0!"  unless $args{StackCost}  > 0;
    croak "ThreadCost must be greater than 0!" unless $args{ThreadCost} > 0;
    $args{Tokens} -= ($codelen * $args{CodeCost});
    croak "Tokens must exceed the code size!"  unless $args{Tokens}     > 0;
    croak "Code must be freeform!  (no newlines)"
        if $args{Blueprint}->code =~ /\n/;

    my $self = bless({}, $package);
    $$self{blueprint}  = $args{Blueprint};
    $$self{boardsize}  = $args{BoardSize} if exists $args{BoardSize};
    $$self{code}       = $$self{blueprint}->code;
    $$self{codecost}   = $args{CodeCost};
    $$self{codesize}   = $$self{blueprint}->size;
    $$self{config}     = $args{Config};
    $$self{dims}       = $$self{codesize}->get_dims();
    $$self{itercost}   = $args{IterCost};
    $$self{repeatcost} = $args{RepeatCost};
    $$self{stackcost}  = $args{StackCost};

lib/AI/Evolve/Befunge/Critter/Result.pm  view on Meta::CPAN

    my $self = {
        died         => 0,
        fate         => '',
        moves        => 0,
        score        => 0,
        stats        => {},
        tokens       => 0,
        won          => 0,
        @_
    };
    return bless($self, $package);
}

=head1 NAME

    AI::Evolve::Befunge::Critter::Result - results object


=head1 DESCRIPTION

This object stores the fate of a critter.  It stores whether it died

lib/AI/Evolve/Befunge/Migrator.pm  view on Meta::CPAN

    my $port = global_config('migrationd_port', 29522);
    my $self = {
        host  => $host,
        port  => $port,
        dead  => 0,
        loc   => $args{Local},
        rxbuf => '',
        txbuf => '',
        lastc => 0,
    };
    return bless($self, $package);
}


=head2 spawn_migrator

    my $socket = spawn_migrator($config);

Spawn off an external migration child process.  This process will live
as long as the returned socket lives; it will die when the socket is
closed.  See AI::Evolve::Befunge::Migrator for implementation details.

lib/AI/Evolve/Befunge/Physics.pm  view on Meta::CPAN

sub new {
    my ($package, $physics) = @_;
    my $usage = 'Usage: Physics->new($physicsname);';
    croak($usage) unless defined($package);
    croak($usage) unless defined($physics);
    my $module = 'AI::Evolve::Befunge::Physics::' . $physics;
    $module->require;
    my $rv = find_physics($physics);
    croak("no such physics module found") unless defined $rv;
    $rv = {%$rv}; # copy of the original object
    return bless($rv, $module);
}


=head1 METHODS

Once you have obtained a class instance by calling ->new(), you may
call the following methods on that instance.

=head2 run_board_game

lib/AI/Evolve/Befunge/Population.pm  view on Meta::CPAN

    Host - the hostname of this Population.      (Default: `hostname`)

=cut

sub new {
    my ($package, %args) = @_;
    $args{Host}         = $ENV{HOST} unless defined $args{Host};
    $args{Generation} //= 1;
    $args{Blueprints} //= [];

    my $self = bless({
        host       => $args{Host},
        blueprints => [],
        generation => $args{Generation},
        migrate    => spawn_migrator(),
    }, $package);

    $self->reload_defaults();
    my $nd          = $self->dimensions;
    my $config      = $self->config;
    my $code_size   = v(map { 4 } (1..$nd));

lib/AI/Evolve/Befunge/Population.pm  view on Meta::CPAN

            $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,
        migrate    => spawn_migrator(),
    }, $package);
    $self->reload_defaults();
    return $self;
}

t/02physics.t  view on Meta::CPAN

# this game is a sort of miniature tic tac toe, played on a 2x2 board.
# one difference: only diagonal lines are counted as wins.

use AI::Evolve::Befunge::Util;
use base 'AI::Evolve::Befunge::Physics';
use AI::Evolve::Befunge::Physics  qw(register_physics);

sub new {
    my $package = shift;
    return bless({}, $package);
}

sub get_token { return ord('_'); }

sub decorate_valid_moves {
    return 0;
}

sub valid_move {
    my ($self, $board, $player, $v) = @_;

t/02physics.t  view on Meta::CPAN

use Carp;

# this is a boring, non-game physics engine.  Not much to see here.

use AI::Evolve::Befunge::Util;
use base 'AI::Evolve::Befunge::Physics';
use AI::Evolve::Befunge::Physics  qw(register_physics);

sub new {
    my $package = shift;
    return bless({}, $package);
}

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; }

t/05critter.t  view on Meta::CPAN

our $t;
our @p;
BEGIN { $t = 0 };

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);

t/09population.t  view on Meta::CPAN

use Carp;

# this is a boring, non-game physics engine.  Not much to see here.

use AI::Evolve::Befunge::Util;
use base 'AI::Evolve::Befunge::Physics';
use AI::Evolve::Befunge::Physics  qw(register_physics);

sub new {
    my $package = shift;
    return bless({}, $package);
}

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; }