AI-Evolve-Befunge
view release on metacpan or search on metacpan
#!/usr/bin/perl
use Module::Build;
Module::Build->new(
# standing on the shoulders of giants...
requires => {
'perl' => '5.10.0',
'Algorithm::Evolutionary::Wheel' => 0,
'aliased' => 0,
'Class::Accessor::Fast' => 0,
'Language::Befunge' => '4.10',
'Language::Befunge::Storage::Generic::Vec::XS' => '0.02',
'Language::Befunge::Vector::XS' => '1.1.0',
'LWP::UserAgent' => 0,
'Parallel::Iterator' => 0,
'Perl6::Export::Attrs' => 0,
make of the Package, you should contact the Copyright Holder and seek
a different licensing arrangement.
Definitions
"Copyright Holder" means the individual(s) or organization(s)
named in the copyright notice for the entire Package.
"Contributor" means any party that has contributed code or other
material to the Package, in accordance with the Copyright Holder's
procedures.
"You" and "your" means any person who would like to copy,
distribute, or modify the Package.
"Package" means the collection of files distributed by the
Copyright Holder, and derivatives of that collection and/or of
those files. A given Package may consist of either the Standard
Version, or a Modified Version.
"Distribute" means providing a copy of the Package or making it
Holder.
"Original License" means this Artistic License as Distributed with
the Standard Version of the Package, in its current version or as
it may be modified by The Perl Foundation in the future.
"Source" form means the source code, documentation source, and
configuration files for the Package.
"Compiled" form means the compiled bytecode, object code, binary,
or any other form resulting from mechanical transformation or
translation of the Source form.
Permission for Use and Modification Without Distribution
(1) You are permitted to use the Standard Version and create and use
Modified Versions for any purpose without restriction, provided that
you do not Distribute the Modified Version.
Permissions for Redistribution of the Standard Version
(2) You may Distribute verbatim copies of the Source form of the
Standard Version of this Package in any medium without restriction,
either gratis or for a Distributor Fee, provided that you duplicate
all of the original copyright notices and associated disclaimers. At
your discretion, such verbatim copies may or may not include a
Compiled form of the Package.
(3) You may apply any bug fixes, portability changes, and other
modifications made available from the Copyright Holder. The resulting
Package will still be considered the Standard Version, and as such
will be subject to the Original License.
Distribution of Modified Versions of the Package as Source
(4) You may Distribute your Modified Version as Source (either gratis
or for a Distributor Fee, and with or without a Compiled form of the
Modified Version) provided that you clearly document how it differs
from the Standard Version, including, but not limited to, documenting
any non-standard features, executables, or modules, and provided that
you do at least ONE of the following:
(a) make the Modified Version available to the Copyright Holder
of the Standard Version, under the Original License, so that the
Copyright Holder may include your modifications in the Standard
Version.
(b) ensure that installation of your Modified Version does not
prevent the user installing or running the Standard Version. In
addition, the Modified Version must bear a name that is different
(c) allow anyone who receives a copy of the Modified Version to
make the Source form of the Modified Version available to others
under
(i) the Original License or
(ii) a license that permits the licensee to freely copy,
modify and redistribute the Modified Version using the same
licensing terms that apply to the copy that the licensee
received, and requires that the Source form of the Modified
Version, and of any works derived from it, be made freely
available in that license fees are prohibited but Distributor
Fees are allowed.
Distribution of Compiled Forms of the Standard Version
or Modified Versions without the Source
(5) You may Distribute Compiled forms of the Standard Version without
the Source, provided that you include complete instructions on how to
get the Source of the Standard Version. Such instructions must be
valid at the time of your distribution. If these instructions, at any
time while you are carrying out such distribution, become invalid, you
must provide new instructions on demand or cease further distribution.
If you provide valid instructions or cease distribution within thirty
days after you become aware that the instructions are invalid, then
you do not forfeit any of your rights under this license.
(6) You may Distribute a Modified Version in Compiled form without
the Source, provided that you comply with Section 4 with respect to
the Source of the Modified Version.
Aggregating or Linking the Package
(7) You may aggregate the Package (either the Standard Version or
Modified Version) with other packages and Distribute the resulting
aggregation provided that you do not charge a licensing fee for the
Package. Distributor Fees are permitted, and licensing fees for other
components in the aggregation are permitted. The terms of this license
apply to the use and Distribution of the Standard or Modified Versions
as included in the aggregation.
(8) You are permitted to link Modified and Standard Versions with
other works, to embed the Package in a larger work of your own, or to
build stand-alone binary or bytecode versions of applications that
include the Package, and Distribute the result without restriction,
provided the result does not expose a direct interface to the Package.
Items That are Not Considered Part of a Modified Version
(9) Works (including, but not limited to, modules and scripts) that
merely extend or make use of the Package, do not, by themselves, cause
the Package to be a Modified Version. In addition, such works are not
considered parts of the Package itself, and are not subject to the
terms of this license.
(11) If your Modified Version has been derived from a Modified
Version made by someone other than you, you are nevertheless required
to ensure that your Modified Version complies with the requirements of
this license.
(12) This license does not grant you the right to use any trademark,
service mark, tradename, or logo of the Copyright Holder.
(13) This license includes the non-exclusive, worldwide,
free-of-charge patent license to make, have made, use, offer to sell,
sell, import and otherwise transfer the Package with respect to any
patent claims licensable by the Copyright Holder that are necessarily
infringed by the Package. If you institute patent litigation
(including a cross-claim or counterclaim) against any party alleging
that the Package constitutes direct or contributory patent
infringement, then this Artistic License to you shall terminate on the
date that such litigation is filed.
(14) Disclaimer of Warranty:
THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER AND CONTRIBUTORS "AS
IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. THE IMPLIED
---
name: AI-Evolve-Befunge
version: 0.03
author:
- 'Mark Glines <mark@glines.org>'
abstract: practical evolution of Befunge AI programs
license: artistic_2
resources:
license: ~
requires:
Algorithm::Evolutionary::Wheel: 0
Class::Accessor::Fast: 0
LWP::UserAgent: 0
Language::Befunge: 4.10
Language::Befunge::Storage::Generic::Vec::XS: 0.02
Language::Befunge::Vector::XS: 1.1.0
Parallel::Iterator: 0
Perl6::Export::Attrs: 0
Task::Weaken: 0
Test::Exception: 0
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
To install this module type the following:
perl Build.PL
./Build
./Build test
sudo ./Build install
You can copy the config file, example.conf, to /etc/ai-evolve-befunge.conf and
edit it to your heart's content.
DEPENDENCIES
This module requires these other modules and libraries:
perl 5.10.0
Algorithm::Evolutionary::Wheel
aliased
Class::Accessor::Fast
Language::Befunge >= 4.10
Language::Befunge::Storage::Generic::Vec::XS >= 0.02
Language::Befunge::Vector::XS >= 1.1.0
LWP::UserAgent
Parallel::Iterator
Perl6::Export::Attrs
Task::Weaken
Test::Exception
Test::MockRandom
Test::Output
UNIVERSAL::require
YAML
In addition to the above, the test suite can optionally use Test::Pod and
Devel::Leak. Without each of these, it will skip a portion of the tests.
Note: the Devel::Leak tests result in a lot of ugly hexspam, so it probably
isn't worth the trouble. The Pod test is nice though.
AUTHOR
Mark Glines <mark-befunge@glines.org>
CONTACT
You can either email me at the above address, or find me on irc.magnet.net with
the nickname "Infinoid". If you want to tell me how much the module rules or
sucks, or if you have any questions about it, that's a good place to start. If
you have a specific bug or feature you want to tell me about (or better yet, a
patch), you can send it to:
bug-AI-Evolve-Befunge@rt.cpan.org
That will add it to the issue tracker so it won't get lost.
example.conf view on Meta::CPAN
# 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
# The number of CPUs (or cores) this node has. This affects the number of
# worker child processes.
cpus: 1
# The number of critters alive in each generation.
popsize: 40
# NETWORKING
# 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
# The number of resource tokens each critter gets, per battle.
tokens: 2000
# Number of tokens each character of code costs.
code_cost: 1
# Number of tokens each clock cycle costs (per thread).
iter_cost: 2
# Number of tokens each repeat-cycle (from the "k" instruction) costs.
repeat_cost: 1
lib/AI/Evolve/Befunge.pm view on Meta::CPAN
$pop->breed();
$pop->migrate();
$pop->save();
$pop->generation($gen+1);
}
=head1 DESCRIPTION
This software project provides all of the necessary tools to grow a
population of AI creatures which are fit to perform a task.
Normally, end users can use the "evolve" script as a frontend. If
that's what you're after, please see the documentation contained
within that script. Otherwise, read on.
This particular file (AI/Evolve/Befunge.pm) does not contain any code;
it exists mainly to provide a version number to keep Build.PL happy.
The rest of this file acts as a quick-start guide to the rest of the
codebase.
The important bits from a user's standpoint are the Population object
(which drives the main process of evolving AI), and the Physics plugin
(which implements the rules of the universe those AI live in). There
are sections below containing more detail on what these two things
are, and how they work.
=head1 POPULATIONS
The Population object is the main user interface to this project.
Basically you just keep running it over and over, and presumably, the
result gets better and better.
The important thing to remember here is that the results take time -
it will probably take several weeks of solid processing time before you
begin to see any promising results at all. It takes a lot of random
code generation before it starts to generate code that does what you
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
lib/AI/Evolve/Befunge/Blueprint.pm view on Meta::CPAN
$$self{host} = $ENV{HOST} unless defined $$self{host};
$$self{name} = "$$self{host}-$$self{id}";
return $self;
}
=head2 new_from_string
my $blueprint = Blueprint->new_from_string($string);
Parses a text representation of a blueprint, returns a Blueprint
object. The text representation was likely created by L</as_string>,
below.
=cut
sub new_from_string {
my ($package, $line) = @_;
return undef unless defined $line;
chomp $line;
if($line =~ /^\[I(-?\d+) D(\d+) F(\d+) H([^\]]+)\](.+)/) {
my ($id, $dimensions, $fitness, $host, $code) = ($1, $2, $3, $4, $5);
lib/AI/Evolve/Befunge/Blueprint.pm view on Meta::CPAN
);
}
return undef;
}
=head2 new_from_file
my $blueprint = Blueprint->new_from_file($file);
Reads a text representation (single line of text) of a blueprint from
a results file (or a migration file), returns a Blueprint object.
Calls L</new_from_string> to do the dirty work.
=cut
sub new_from_file {
my ($package, $file) = @_;
return $package->new_from_string($file->getline);
}
=head2 as_string
print $blueprint->as_string();
Return a text representation of this blueprint. This is suitable for
sticking into a results file, or migrating to another node. See
L</new_from_string> above.
=cut
sub as_string {
my $self = shift;
my $rv =
"[I$$self{id} D$$self{dims} F$$self{fitness} H$$self{host}]";
$rv .= $$self{code};
$rv .= "\n";
lib/AI/Evolve/Befunge/Blueprint.pm view on Meta::CPAN
$_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();
lib/AI/Evolve/Befunge/Critter.pm view on Meta::CPAN
9| | | 9
---+--------------------+---
|09876543210123456789|
|1 | |
|----------| |
Where:
C is befunge code. This is the code under test.
B is boardgame data. Each location is binary 0, 1 or 2 (or
whatever tokens the game uses to represent
unoccupied spaces, and the various player
pieces). The B section only exists for
board game applications.
Everything else is free for local use. Note that none of this is
write protected - a program is free to reorganize and/or overwrite
itself, the game board, results table, or anything else within the
space it was given.
The universe is implemented as a hypercube of 1 or more dimensions.
The universe size is simply the code size times two, or the board size
times two, whichever is larger. If the board exists in 2 dimensions
but the code exists in more, the board will be represented as a square
starting at (0,0,...) and will only exist on plane 0 of the non-(X,Y)
axes.
Several attributes of the universe are pushed onto the initial stack,
in the hopes that the critter can use this information to its
advantage. The values pushed are (in order from the top of the stack
(most accessible) to the bottom (least accessible)):
* the Physics token (implying the rules of the game/universe)
* the number of dimensions this universe operates in
lib/AI/Evolve/Befunge/Critter.pm view on Meta::CPAN
* The iter cost (see LIMITS, below)
* The repeat cost (see LIMITS, below)
* The stack cost (see LIMITS, below)
* The thread cost (see LIMITS, below)
* The code size (a Vector)
* The maximum storage size (a Vector)
* The board size (a Vector) if operating in a boardgame universe
If a Critter instance will have it's ->invoke() method called more
than once (for board game universes, it is called once per "turn"),
the storage model is not re-created. The critter is responsible for
preserving enough of itself to handle multiple invocations properly.
The Language::Befunge Interpreter and Storage model are preserved,
though a new IP is created each time, and (for board game universes)
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
lib/AI/Evolve/Befunge/Critter.pm view on Meta::CPAN
=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)
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/Critter/Result.pm view on Meta::CPAN
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
or lived, what the error message was (if it died), whether it won, and
if it was playing a board game, whether it choose a move. It also
stores some statistical information about how many moves it made, and
stuff like that.
=head1 CONSTRUCTOR
=head2 new
Result->new();
Create a new Result object.
lib/AI/Evolve/Befunge/Critter/Result.pm view on Meta::CPAN
thought the critter did.
=item stats
Some additional statistics generated by the run_board_game method in
Physics.pm.
=item tokens
Integer value indicating how much "currency" the critter had left
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/Migrator.pm view on Meta::CPAN
}
=head1 METHODS
=head2 spin
$migrator->spin();
This is the main control component of this module. It looks for
incoming events and responds to them.
=cut
sub spin {
my $self = shift;
$self->spin_reads();
$self->spin_writes();
$self->spin_exceptions();
}
lib/AI/Evolve/Befunge/Physics.pm view on Meta::CPAN
=head1 DESCRIPTION
This module serves a double purpose.
First, it serves as a plugin repository for Physics engines. It
allows physics engines to register themselves, and it allows callers
to fetch entries from the database (indexed by the name of the Physics
engine).
Second, it serves as a base class for Physics engines. It creates
class instances to represent a Physics engine, and given a blueprint
or two, allows callers to run creatures in a universe which follow the
rules of that Physics engine.
=head1 STANDALONE FUNCTIONS
=head2 register_physics
register_physics(
name => "ttt",
token => ord('T'),
lib/AI/Evolve/Befunge/Physics.pm view on Meta::CPAN
);
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
lib/AI/Evolve/Befunge/Physics.pm view on Meta::CPAN
Run the two critters repeatedly, so that they can make moves in a
board game.
A score value is returned. If a number greater than 0 is returned,
the critter wins. If a number less than 0 is returned, the critter
loses.
The score value is derived in one of several ways... first priority
is to bias toward a creature which won the game, second is to bias
toward a creature who did not die (when the other did), third,
the physics plugin is asked to score the creatures based on the moves
they made, and finally, a choice is made based on the number of
resources each critter consumed.
=cut
sub run_board_game {
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;
lib/AI/Evolve/Befunge/Physics.pm view on Meta::CPAN
}
$moves++;
$self->make_move($board, $players[0]{critter}->color(), $move) if defined $move;
# swap players
my $player = shift @players;
push(@players,$player);
}
$board->output() unless get_quiet();
# tally up the results to feed to compare(), below.
my ($rv1 , $rv2 ) = ($orig_players[0]{rv} , $orig_players[1]{rv} );
my ($stats1, $stats2) = ($orig_players[0]{stats}, $orig_players[1]{stats});
$rv1->stats($stats1);
$rv2->stats($stats2);
$rv1->won(1) if $self->won($board) == $critter1->color();
$rv2->won(1) if $self->won($board) == $critter2->color();
$rv1->score($self->score($board, $critter1->color, $moves));
$rv2->score($self->score($board, $critter2->color, $moves));
return $self->compare($rv1, $rv2);
}
lib/AI/Evolve/Befunge/Physics.pm view on Meta::CPAN
return $self->run_board_game([$critter1,$critter2], $board);
}
=head2 double_match
my $relative_score = $physics->double_match($bp1, $bp2);
Runs two board games; one with bp1 starting first, and again with
bp2 starting first. The second result is subtracted from the first,
and the result is returned. This represents a qualitative comparison
between the two creatures. This can be used as a return value for
mergesort or qsort.
=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';
lib/AI/Evolve/Befunge/Physics.pm view on Meta::CPAN
These functions are intended for use as Befunge opcode handlers, and
are used by the Physics plugin modules.
=head2 op_make_board_move
01M
Pops a vector (of the appropriate dimensions for the given board, not
necessarily the same as the codesize) from the stack, and attempts
to make that "move". This is for Physics engines which represent
board games.
=cut
sub op_make_board_move {
my ($interp)= @_;
my $critter = $$interp{_ai_critter};
my $board = $$interp{_ai_board};
my $color = $$critter{color};
my $physics = $$critter{physics};
lib/AI/Evolve/Befunge/Physics/ttt.pm view on Meta::CPAN
=cut
sub score {
my ($self, $board, $player, $moves) = @_;
if($self->won($board) == $player) {
# won! the quicker, the better.
return 20 - $moves;
}
if($self->won($board)) {
# lost; prolonging defeat scores better
return $moves;
}
# draw
return 10 if $self->over($board);
# game isn't over yet
my $mine = 0;
foreach my $y (0..2) {
foreach my $x (0..2) {
if($board->fetch_value(v($x, $y)) == $player) {
$mine++;
lib/AI/Evolve/Befunge/Population.pm view on Meta::CPAN
}
=head1 DESCRIPTION
This manages a population of Befunge AI critters.
This is the main evolution engine for AI::Evolve::Befunge. It has
all of the steps necessary to evolve a population and generate the
next generation. The more times you run this process, the more
progress it will (theoretically) make.
=head1 CONSTRUCTORS
There are two constructors, depending on whether you want to create
a new population, or resume a saved one.
=head2 new
my $population = Population->new(Generation => 50);
Creates a Population object. The following arguments may be
specified (none are mandatory):
Blueprints - a list (array reference) of critters. (Default: [])
lib/AI/Evolve/Befunge/Population.pm view on Meta::CPAN
use IO::File;
my @population;
my ($generation, $host);
$host = $ENV{HOST};
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";
}
lib/AI/Evolve/Befunge/Population.pm view on Meta::CPAN
my (@winners, @livers, @fights);
while(@population) {
my $attacker = shift @population;
my $attacked = shift @population;
if(!defined($attacked)) {
push(@livers, $attacker);
} else {
push(@fights, [$attacker, $attacked]);
}
}
my @results = iterate_as_array(
{ workers => $workers },
sub {
my ($index, $aref) = @_;
my ($attacker, $attacked) = @$aref;
my $score;
$score = $physics->double_match($config, $attacker, $attacked);
my $winner = $attacked;
$winner = $attacker if $score > -1;
return [$winner->name, $score];
},
\@fights);
foreach my $result (@results) {
my ($winner, $score) = @$result;
$winner = $blueprints{$winner};
if($score) {
# they actually won
push(@winners, $winner);
} else {
# they merely tied
push(@livers, $winner);
}
}
@population = (@winners, @livers);
lib/AI/Evolve/Befunge/Population.pm view on Meta::CPAN
=head2 breed
$population->breed();
Bring the population count back up to the "popsize" level, by a
process of sexual reproduction. The newly created critters will have
a combination of two previously existing ("winners") genetic makeup,
plus some random mutation. See the L</crossover> and L</mutate>
methods, below. There is also a one of 5 chance a critter will be
resized, see the L</crop> and L</grow> methods, below.
=cut
sub breed {
my $self = shift;
my $popsize = $self->popsize;
my $nd = $self->dimensions;
my @population = @{$self->blueprints};
my @probs = map { $$_{fitness} } (@population);
while(@population < $popsize) {
lib/AI/Evolve/Befunge/Population.pm view on Meta::CPAN
push @population, $child1;
}
$self->blueprints([@population]);
}
=head2 migrate
$population->migrate();
Send and receive critters to/from other populations. This requires an
external networking script to be running.
Exported critters are saved to a "migrate-$HOST/out" folder. The
networking script should broadcast the contents of any files created
in this directory, and remove the files afterwards.
Imported critters are read from a "migrate-$HOST/in" folder. The
files are removed after they have been read. The networking script
should save any received critters to individual files in this folder.
lib/AI/Evolve/Befunge/Population.pm view on Meta::CPAN
$self->migrate_export();
$self->migrate_import();
}
=head2 save
$population->save();
Write out the current population state. Savefiles are written to a
"results-$HOST/" folder. Also calls L</cleanup_intermediate_savefiles>
to keep the results directory relatively clean, see below for the
description of that method.
=cut
sub save {
my $self = shift;
my $gen = $self->generation;
my $pop = $self->blueprints;
my $host = $self->host;
my $results = "results-$host";
mkdir($results);
my $fnbase = "$results/" . join('-', $host, $self->physics->name);
my $fn = "$fnbase-$gen";
unlink("$fn.tmp");
my $savefile = IO::File->new(">$fn.tmp");
my $popid = new_popid();
$savefile->print("generation=$gen\n");
$savefile->print("popid=$popid\n");
foreach my $critter (@$pop) {
$savefile->print($critter->as_string);
}
$savefile->close();
lib/AI/Evolve/Befunge/Population.pm view on Meta::CPAN
delete($$chr1{cache});
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;
lib/AI/Evolve/Befunge/Population.pm view on Meta::CPAN
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
savefiles, and tosses the rest. For example, if the current
generation is 4123, it would preserve only the following:
savefile-1
savefile-10
savefile-100
savefile-1000
savefile-2000
savefile-3000
savefile-4000
savefile-4100
savefile-4110
lib/AI/Evolve/Befunge/Population.pm view on Meta::CPAN
This allows the savefiles to accumulate and allows access to some recent
history, and yet use much less disk space than they would otherwise.
=cut
sub cleanup_intermediate_savefiles {
my $self = shift;
my $gen = $self->generation;
my $physics = $self->physics;
my $host = $self->host;
my $results = "results-$host";
mkdir($results);
my $fnbase = "$results/" . join('-', $host, $physics->name);
return unless $gen;
for(my $base = 1; !($gen % ($base*10)); $base *= 10) {
my $start = $gen - ($base*10);
if($base * 10 != $gen) {
for(1..9) {
my $delfn = "$fnbase-" . ($start+($_*$base));
unlink($delfn) if -f $delfn;
}
}
}
}
=head2 migrate_export
$population->migrate_export();
Possibly export some critters. if the result of rand(13) is greater
than 10, than the value (minus 10) number of critters are written out
to the migration network.
=cut
sub migrate_export {
my ($self) = @_;
$$self{migrate}->blocking(1);
# export some critters
for my $id (0..(rand(13)-10)) {
lib/AI/Evolve/Befunge/Population.pm view on Meta::CPAN
my ($c1, $c2) = $population->pair(map { 1 } (@population));
my ($c1, $c2) = $population->pair(map { $_->fitness } (@population));
Randomly select and return two blueprints from the blueprints array.
Some care is taken to ensure that the two blueprints returned are not
actually two copies of the same blueprint.
The @fitness parameter is used to weight the selection process. There
must be one number passed per entry in the blueprints array. If you
pass a list of 1's, you will get an equal probability. If you pass
the critter's fitness scores, the more fit critters have a higher
chance of selection.
=cut
sub pair {
my $self = shift;
my @population = @{$self->blueprints};
my $popsize = scalar @population;
my $matchwheel = Algorithm::Evolutionary::Wheel->new(@_);
my $c1 = $matchwheel->spin();
lib/AI/Evolve/Befunge/Util.pm view on Meta::CPAN
}
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 {
lib/AI/Evolve/Befunge/Util.pm view on Meta::CPAN
global config database, but allows for overrides by various criteria -
it allows you to specify overridden values for particular generations
(if the current generation is greater than or equal to the ones in the
config file, with inheritance), for particular physics engines, and
for particular hostnames.
This is more specific than L</global_config> can be. This is the
interface you should be using in almost all cases.
If you don't specify a particular attribute, overrides by that
attribute will not show up in the resulting config. This is so you
can (for instance) specify a host-specific override for the physics
engine, and query that successfully before knowing which physics
engine you will be using.
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.
lib/AI/Evolve/Befunge/Util/Config.pm view on Meta::CPAN
use AI::Evolve::Befunge::Util;
my $config = custom_config(host => 'test', physics => 'ttt', gen => 1024);
my $value = $config->config('value', 'default');
=head2 DESCRIPTION
This is a config object. The config file allows overrides based on
hostname, physics engine in use, and AI generation. Thus, the config
file data needs to be re-assessed every time one of these (usually
just the generation) is changed. The result of this is a Config
object, which is what this module implements.
=head1 CONSTRUCTOR
=head2 custom_config
This module does not actually implement the constructor - please see
custom_config() in L<AI::Evolve::Befunge::Util> for the details.
t/02physics.t view on Meta::CPAN
push_quiet(1);
# registration API
dies_ok(sub { register_physics(foo => 'bar') }, "no name");
lives_ok(sub{ register_physics(name => 'test0', foo => 'bar') }, "registration");
dies_ok(sub { register_physics(name => 'test0', foo => 'bar') }, "reregistration");
my $test = AI::Evolve::Befunge::Physics::find_physics("test0");
is($$test{foo}, 'bar', "our fake physics engine was registered properly");
$test = AI::Evolve::Befunge::Physics::find_physics("unknown");
is($$test{foo}, undef, "unknown engine results in undef");
BEGIN { $num_tests += 5 };
# constructor
dies_ok(sub { AI::Evolve::Befunge::Physics::new }, 'no package');
dies_ok(sub { Physics->new }, 'no plugin');
dies_ok(sub { Physics->new('unknown') }, 'nonexistent plugin');
my $config = custom_config();
$test = Physics->new('test1');
ok(ref($test) eq "AI::Evolve::Befunge::Physics::test1", "create a test physics object");
t/02physics.t view on Meta::CPAN
return 1;
}
sub score {
my ($self, $board, $player, $moves) = @_;
if($self->won($board) == $player) {
# won! the quicker, the better.
return 20 - $moves;
}
if($self->won($board)) {
# lost; prolonging defeat scores better
return $moves;
}
# draw
return 0 if $self->over($board);
# game isn't over yet
my $mine = 0;
foreach my $y (0..1) {
foreach my $x (0..1) {
if($board->fetch_value(v($x, $y)) == $player) {
$mine++;
t/08physics_othello.t view on Meta::CPAN
[0,2,2,2,0,1,1,1], # 2
[0,2,0,2,0,1,1,1], # 3
[0,2,1,2,0,1,1,1], # 4
[0,2,2,2,0,1,1,1], # 5
[0,0,0,0,0,0,0,0], # 6
[0,0,0,0,0,0,0,0], # 7
# 0 1 2 3 4 5 6 7
];
is($othello->won( $board), 0, "game not won yet");
is($othello->over($board), 0, "game not over yet");
is($othello->make_move($board,2,v(2,3)), 0, "no valid moves, equal scores, tie game");
$$board{b} = [
[0,0,0,0,0,0,0,0], # 0
[0,0,0,0,0,0,0,0], # 1
[0,2,2,2,0,0,0,0], # 2
[0,2,2,2,0,0,0,0], # 3
[0,2,2,2,0,0,0,0], # 4
[0,2,2,2,0,0,0,0], # 5
[0,0,0,0,0,0,0,0], # 6
[0,0,0,0,0,0,0,0], # 7
# 0 1 2 3 4 5 6 7
t/09population.t view on Meta::CPAN
$population[3]{host} = 'not_test';
$population[6]{host} = 'not_test1';
$population[7]{host} = 'not_test2';
$population[8]{host} = 'not_test';
seed(0.3, 0, 0.7, oneish);
$population->blueprints([@population]);
$population->fight();
@population = @{$population->blueprints};
is(scalar @population, 3, 'population reduced to 25% of its original size');
BEGIN { $num_tests += 1 };
my @expected_results = (
{id => -4, code => $scorer3, fitness => 3, host => 'not_test1'},
{id => -2, code => $scorer2, fitness => 2, host => 'not_test'},
{id => -10, code => $quit1, fitness => 1, host => 'test'},
);
my $ref = $population->blueprints;
for my $id (0..@expected_results-1) {
is($$ref[$id]{id}, $expected_results[$id]{id}, "sorted $id id right");
is($$ref[$id]{fitness}, $expected_results[$id]{fitness}, "sorted $id fitness right");
is($$ref[$id]{host}, $expected_results[$id]{host}, "sorted $id host right");
is($$ref[$id]{code}, $expected_results[$id]{code}, "sorted $id code right");
}
BEGIN { $num_tests += 4*3 };
# pair
seed(oneish, oneish);
my ($c1, $c2) = $population->pair(map { $$_{fitness} } (@population));
is($$c1{id}, $population[2]{id}, "pair bias works");
is($$c2{id}, $population[0]{id}, "pair bias works");
seed(0, 0);
t/09population.t view on Meta::CPAN
# save
my $goodfile = IO::File->new('t/savefile');
my $subdir = tempdir(CLEANUP => 1);
my $olddir = getcwd();
chdir($subdir);
$population->generation(0);
$population->cleanup_intermediate_savefiles();
$population->generation(999);
$population->save();
ok(-d 'results-host', 'results subdir has been created');
ok(-f 'results-host/host-ttt-999', 'filename is correct');
$population->generation(1000);
$population->save();
ok(!-f 'results-host/host-ttt-999', 'old filename is removed');
ok(-f 'results-host/host-ttt-1000', 'new filename is still there');
my $testfile = IO::File->new(<results-host/*>);
{
local $/ = undef;
my $gooddata = <$goodfile>;
my $testdata = <$testfile>;
is($testdata, $gooddata, 'savefile contents match up');
undef $goodfile;
undef $testfile;
}
chdir($olddir);
BEGIN { $num_tests += 5 };
t/09population.t view on Meta::CPAN
# 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');
$ref = $population->blueprints;
is(scalar @$ref, 3, '$population->load returned the right number of blueprints');
BEGIN { $num_tests += 6 };
@expected_results = (
{id => -4, code => $scorer3, fitness => 3, host => 'not_test1'},
{id => -2, code => $scorer2, fitness => 2, host => 'not_test'},
{id => -10, code => $quit1, fitness => 1, host => 'test'},
);
for my $id (0..@expected_results-1) {
is($$ref[$id]{id}, $expected_results[$id]{id}, "loaded $id id right");
is($$ref[$id]{host}, $expected_results[$id]{host}, "loaded $id host right");
is($$ref[$id]{code}, $expected_results[$id]{code}, "loaded $id code right");
is($$ref[$id]{fitness}, $expected_results[$id]{fitness}, "loaded $id fitness right");
}
BEGIN { $num_tests += 4*3 };
package AI::Evolve::Befunge::Physics::test;
use strict;
use warnings;
use Carp;
# this is a boring, non-game physics engine. Not much to see here.
t/10migration.t view on Meta::CPAN
$population->popsize(5);
sleep(0.25);
seed(0.85);
alarm(3);
$population->migrate();
is($incoming->getline, '[I-4 D4 F3 Hnot_test1]'.$scorer3."\n", 'migration exported a critter');
alarm(0);
my $ref = $population->blueprints;
is(scalar @$ref, 8, 'there are now 8 blueprints in list');
BEGIN { $num_tests += 3 };
my @expected_results = (
{id => -4, code => $scorer3, fitness => 3, host => 'not_test1'},
{id => -2, code => $scorer2, fitness => 2, host => 'not_test'},
{id => -10, code => $quit1, fitness => 1, host => 'test'},
{id => 12345, code => 'abcdefgh', fitness => 31, host => 'test2'},
{id => 12346, code => 'abcdefgi', fitness => 30, host => 'test2'},
{id => 12347, code => 'abcdefgj', fitness => 29, host => 'test2'},
{id => 12348, code => 'abcdefgk', fitness => 28, host => 'test2'},
{id => 12349, code => 'abcdefgl', fitness => 27, host => 'test2'},
);
for my $id (0..@expected_results-1) {
is($$ref[$id]{id}, $expected_results[$id]{id}, "loaded $id id right");
is($$ref[$id]{host}, $expected_results[$id]{host}, "loaded $id host right");
is($$ref[$id]{code}, $expected_results[$id]{code}, "loaded $id code right");
is($$ref[$id]{fitness}, $expected_results[$id]{fitness}, "loaded $id fitness right");
}
BEGIN { $num_tests += 8*4 };
# migrate (no overrun)
undef $population;
$population = AI::Evolve::Befunge::Population->load('t/savefile');
is(scalar @{$population->blueprints}, 3, "3 critters to start with");
$population->host('whee');
$population->popsize(8);
sleep(0.25);
seed(0.85);
alarm(3);
$population->migrate();
is($incoming->getline, '[I-2 D4 F2 Hnot_test]'.$scorer2."\n", 'migration exported a critter');
$population->migrate();
alarm(0);
$ref = $population->blueprints;
is(scalar @$ref, 9, 'there are now 9 blueprints in list');
BEGIN { $num_tests += 3 };
@expected_results = (
{id => -4, code => $scorer3, fitness => 3, host => 'not_test1'},
{id => -2, code => $scorer2, fitness => 2, host => 'not_test'},
{id => -10, code => $quit1, fitness => 1, host => 'test'},
{id => 12345, code => 'abcdefgh', fitness => 31, host => 'test2'},
{id => 12346, code => 'abcdefgi', fitness => 30, host => 'test2'},
{id => 12347, code => 'abcdefgj', fitness => 29, host => 'test2'},
{id => 12348, code => 'abcdefgk', fitness => 28, host => 'test2'},
{id => 12349, code => 'abcdefgl', fitness => 27, host => 'test2'},
{id => 12350, code => 'abcdefgm', fitness => 26, host => 'test2'},
);
for my $id (0..@expected_results-1) {
is($$ref[$id]{id}, $expected_results[$id]{id}, "loaded $id id right");
is($$ref[$id]{host}, $expected_results[$id]{host}, "loaded $id host right");
is($$ref[$id]{code}, $expected_results[$id]{code}, "loaded $id code right");
is($$ref[$id]{fitness}, $expected_results[$id]{fitness}, "loaded $id fitness right");
}
BEGIN { $num_tests += 9*4 };
# migrate (disconnected from test server)
close($incoming);
lives_ok(sub { $population->migrate() }, 'migrate runs without server connection');
waitpid($serverpid, 0);
lives_ok(sub { $population->migrate() }, 'migrate runs without server connection');
BEGIN { $num_tests += 2 };
tools/migrationd view on Meta::CPAN
the whole migration process will be adapted to use Net::Cluster when
that becomes available. Until this feature has stabilized, no
guarantee is made that newer versions of AI::Evolve::Befunge will be
able to talk to this version of the server.
=head1 COMMAND LINE ARGUMENTS
=head2 -h <host/IP>, --host=<host/ip>
Hostname or IP address to listen on. By default, connections will be
accepted on all available IPs.
=head2 -p <port>, --port=<port>
TCP port to listen on. The default port is 29522.
=head2 -q, --quiet
( run in 0.723 second using v1.01-cache-2.11-cpan-49f99fa48dc )