AI-Evolve-Befunge
view release on metacpan or search on metacpan
lib/AI/Evolve/Befunge/Blueprint.pm view on Meta::CPAN
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});
}
croak("code has a non-orthogonal size!")
unless ($$self{size}**$$self{dims}) == length($$self{code});
$$self{size} = Language::Befunge::Vector->new(map { $$self{size} } (1..$$self{dims}));
$$self{fitness} = $args{fitness} // 0;
$$self{id} = $args{id} if exists $args{id};
$$self{host} = $args{host} if exists $args{host};
$$self{id} = $self->new_popid() unless defined $$self{id};
$$self{host} = $ENV{HOST} unless defined $$self{host};
$$self{name} = "$$self{host}-$$self{id}";
return $self;
}
lib/AI/Evolve/Befunge/Board.pm view on Meta::CPAN
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();
}
} else {
if(exists($args{Dimensions})) {
$args{Size} = Language::Befunge::Vector->new(
map { $args{Size} } (1..$args{Dimensions}));
} else {
croak "No Dimensions argument given, and Size isn't a vector";
}
}
$$self{size} = $args{Size};
$$self{dimensions} = $args{Dimensions};
foreach my $dim (0..$$self{size}->get_dims()-1) {
croak("Size[$dim] must be at least 1!")
lib/AI/Evolve/Befunge/Board.pm view on Meta::CPAN
if($dim >= 2) {
croak("This module isn't smart enough to handle more than 2 dimensions yet")
unless $$self{size}->get_component($dim) == 1;
}
}
$$self{sizex} = $$self{size}->get_component(0);
$$self{sizey} = $$self{size}->get_component(1);
$$self{b} = [];
for(0..$$self{sizey}-1) {
push(@{$$self{b}}, [ map { 0 } (1..$$self{sizex})]);
}
return $self;
}
=head1 METHODS
=head2 clear
$board->clear();
Clear the board - set all spaces to 0.
=cut
sub clear {
my $self = shift;
$$self{b} = [];
for(0..$$self{sizey}-1) {
push(@{$$self{b}}, [ map { 0 } (0..$$self{sizex}-1)]);
}
}
=head2 as_string
my $string = $board->as_string();
Returns an ascii-art display of the current board state. The return value
looks like this (without indentation):
.ox
.x.
oxo
=cut
sub as_string {
my $self = shift;
my @char = ('.', 'x', 'o');
my $code = join("\n", map { join('', map { $char[$_] } (@{$$self{b}[$_]}))} (0..$$self{sizey}-1));
return "$code\n";
}
=head2 as_binary_string
my $binary = $board->as_binary_string();
Returns an ascii-art display of the current board state. It looks the same as
->as_string(), above, except that the values it uses are binary values 0, 1,
and 2, rather than plaintext descriptive tokens. This is suitable for passing
to Language::Befunge::LaheySpace::Generic's ->store() method.
=cut
sub as_binary_string {
my $self = shift;
my $code = join("\n",
map { join('', map { chr($_) } (@{$$self{b}[$_]}))} (0..$$self{sizey}-1));
return "$code\n";
}
=head2 output
$board->output();
Prints the return value of the ->as_string() method to the console, decorated
with row and column indexes. The output looks like this (without indentation):
lib/AI/Evolve/Befunge/Board.pm view on Meta::CPAN
my $new_board = $board->copy();
Create a new copy of the board.
=cut
sub copy {
my ($self) = @_;
my $new = ref($self)->new(Size => $$self{size});
my $min = Language::Befunge::Vector->new_zeroes($$self{dimensions});
my $max = Language::Befunge::Vector->new(map { $_ - 1 } ($$self{size}->get_all_components));
for(my $this = $min->copy; defined $this; $this = $this->rasterize($min,$max)) {
$new->set_value($this,$self->fetch_value($this));
}
return $new;
}
1;
lib/AI/Evolve/Befunge/Critter.pm view on Meta::CPAN
$$self{threadcost} = $args{ThreadCost};
$$self{tokens} = $args{Tokens};
if(exists($$self{boardsize})) {
$$self{dims} = $$self{boardsize}->get_dims()
if($$self{dims} < $$self{boardsize}->get_dims());
}
if($$self{codesize}->get_dims() < $$self{dims}) {
# upgrade codesize (keep it hypercubical)
$$self{codesize} = Language::Befunge::Vector->new(
$$self{codesize}->get_all_components(),
map { $$self{codesize}->get_component(0) }
(1..$$self{dims}-$$self{codesize}->get_dims())
);
}
if(exists($$self{boardsize})) {
if($$self{boardsize}->get_dims() < $$self{dims}) {
# upgrade boardsize
$$self{boardsize} = Language::Befunge::Vector->new(
$$self{boardsize}->get_all_components(),
map { 1 } (1..$$self{dims}-$$self{boardsize}->get_dims())
);
}
}
$$self{color} = $args{Color};
croak "Color must be greater than 0" unless $$self{color} > 0;
$$self{physics} = $args{Physics};
croak "Physics must be a reference" unless ref($$self{physics});
# set up our corral to be twice the size of our code or our board, whichever
lib/AI/Evolve/Befunge/Critter.pm view on Meta::CPAN
# 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;
}
}
lib/AI/Evolve/Befunge/Population.pm view on Meta::CPAN
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));
my @population;
foreach my $code (@{$args{Blueprints}}) {
my $chromosome = Blueprint->new(code => $code, dimensions => $nd);
push @population, $chromosome;
}
while(scalar(@population) < $self->popsize()) {
my $size = 1;
foreach my $component ($code_size->get_all_components()) {
lib/AI/Evolve/Befunge/Population.pm view on Meta::CPAN
=cut
sub fight {
my $self = shift;
my $physics = $self->physics;
my $popsize = $self->popsize;
my $config = $self->config;
my $workers = $config->config("cpus", 1);
my @population = @{$self->blueprints};
my %blueprints = map { $_->name => $_ } (@population);
$popsize = ceil($popsize / 4);
while(@population > $popsize) {
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]);
lib/AI/Evolve/Befunge/Population.pm view on Meta::CPAN
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) {
my ($p1, $p2) = $self->pair(@probs);
my $child1 = AI::Evolve::Befunge::Blueprint->new(code => $p1->code, dimensions => $nd);
my $child2 = AI::Evolve::Befunge::Blueprint->new(code => $p2->code, dimensions => $nd, id => -1);
$child1 = $self->grow($child1);
$self->crossover($child1, $child2);
$self->mutate($child1);
$child1 = $self->crop($child1);
push @population, $child1;
}
lib/AI/Evolve/Befunge/Population.pm view on Meta::CPAN
Overwrite a section of the blueprint's code with trash. The section
size, location, and the trash are all randomly generated.
=cut
sub mutate {
my ($self, $blueprint) = @_;
my $code_size = $blueprint->size;
my $code_density = $self->config->config('code_density', 70);
my $base = Language::Befunge::Vector->new(
map { int(rand($code_size->get_component($_))) } (0..$self->dimensions-1));
my $size = Language::Befunge::Vector->new(
map { my $d = ($code_size->get_component($_)-1) - $base->get_component($_);
int($d/(rand($d)+1)) } (0..$self->dimensions-1));
my $end = $base + $size;
my $code = $blueprint->code;
for(my $v = $base->copy(); defined($v); $v = $v->rasterize($base, $end)) {
my $pos = 0;
for my $d (0..$v->get_dims()-1) {
$pos *= $code_size->get_component($d);
$pos += $v->get_component($d);
}
vec($code,$pos,8) = ord($self->new_code_fragment(1,$code_density));
lib/AI/Evolve/Befunge/Population.pm view on Meta::CPAN
Swaps a random chunk of code in the first blueprint with the same
section of the second blueprint. Both blueprints are modified.
=cut
sub crossover {
my ($self, $chr1, $chr2) = @_;
my $code_size = $chr1->size;
my $base = Language::Befunge::Vector->new(
map { int(rand($code_size->get_component($_))) } (0..$self->dimensions-1));
my $size = Language::Befunge::Vector->new(
map { my $d = ($code_size->get_component($_)-1) - $base->get_component($_);
int($d/(rand($d)+1)) } (0..$self->dimensions-1));
my $end = $base + $size;
my $code1 = $chr1->code;
my $code2 = $chr2->code;
# upgrade code sizes if necessary
$code1 .= ' 'x(length($code2)-length($code1))
if(length($code1) < length($code2));
$code2 .= ' 'x(length($code1)-length($code2))
if(length($code2) < length($code1));
for(my $v = $base->copy(); defined($v); $v = $v->rasterize($base, $end)) {
lib/AI/Evolve/Befunge/Population.pm view on Meta::CPAN
=cut
sub crop {
my ($self, $chromosome) = @_;
return $chromosome if int(rand(10));
my $nd = $chromosome->dims;
my $old_size = $chromosome->size;
return $chromosome if $old_size->get_component(0) < 4;
my $new_base = Language::Befunge::Vector->new_zeroes($nd);
my $old_base = $new_base->copy;
my $ones = Language::Befunge::Vector->new(map { 1 } (1..$nd));
my $old_offset = Language::Befunge::Vector->new(
map { int(rand()*2) } (1..$nd));
my $new_size = $old_size - $ones;
my $old_end = $old_size - $ones;
my $new_end = $new_size - $ones;
my $length = 1;
map { $length *= ($_) } ($new_size->get_all_components);
my $new_code = '';
my $old_code = $chromosome->code();
my $vec = Language::Befunge::Storage::Generic::Vec->new($nd, Wrapping => undef);
for(my $new_v = $new_base->copy(); defined($new_v); $new_v = $new_v->rasterize($new_base, $new_end)) {
my $old_v = $new_v + $old_offset;
my $old_offset = $vec->_offset($old_v, $new_base, $old_end);
my $new_offset = $vec->_offset($new_v, $new_base, $new_end);
$new_code .= substr($old_code, $old_offset, 1);
}
return AI::Evolve::Befunge::Blueprint->new(code => $new_code, dimensions => $nd);
lib/AI/Evolve/Befunge/Population.pm view on Meta::CPAN
=cut
sub grow {
my ($self, $chromosome) = @_;
return $chromosome if int(rand(10));
my $nd = $chromosome->dims;
my $old_size = $chromosome->size;
my $old_base = Language::Befunge::Vector->new_zeroes($nd);
my $new_base = $old_base->copy();
my $ones = Language::Befunge::Vector->new(map { 1 } (1..$nd));
my $new_size = $old_size + $ones;
my $old_end = $old_size - $ones;
my $new_end = $new_base + $new_size - $ones;
my $length = 1;
map { $length *= ($_) } ($new_size->get_all_components);
return $chromosome if $length > $self->tokens;
my $new_code = ' ' x $length;
my $old_code = $chromosome->code();
my $vec = Language::Befunge::Storage::Generic::Vec->new($nd, Wrapping => undef);
for(my $old_v = $old_base->copy(); defined($old_v); $old_v = $old_v->rasterize($old_base, $old_end)) {
my $new_v = $old_v + $new_base;
my $old_offset = $vec->_offset($old_v, $old_base, $old_end);
my $new_offset = $vec->_offset($new_v, $new_base, $new_end);
substr($new_code, $new_offset, 1) = substr($old_code, $old_offset, 1);
}
lib/AI/Evolve/Befunge/Population.pm view on Meta::CPAN
$chr = $safe[int(rand()*(scalar @safe))];
}
$rv .= $chr;
}
return $rv;
}
=head2 pair
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.
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
stdout_is(sub { code_print(join("",map { chr(ord('a')+$_) } (0..24)),5,5) }, <<EOF, "code_print (ascii)");
01234
0 abcde
1 fghij
2 klmno
3 pqrst
4 uvwxy
EOF
stdout_is(sub { code_print(join("",map { chr(1+$_) } (0..25)),11,3) }, <<EOF, "code_print (hex)");
1
0 1 2 3 4 5 6 7 8 9 0
0 1 2 3 4 5 6 7 8 9 a b
1 c d e f 10 11 12 13 14 15 16
2 17 18 19 1a 0 0 0 0 0 0 0
EOF
dies_ok(sub { code_print }, "no code");
dies_ok(sub { code_print("") }, "no sizex");
dies_ok(sub { code_print("", 1) }, "no sizey");
BEGIN { $num_tests += 5 };
t/09population.t view on Meta::CPAN
my $concede1 = "z";
my $dier1 = "0k" . ' 'x14;
# the following critters require 5 characters per line, thus they operate in a
# 5**4 space.
# will try (1,1), then (2,0), then (0,2)
my $scorer1 = "[ @]02M^]20M^]11M^" . (' 'x605);
# will try (2,0), then (2,1), then (2,2)
my $scorer2 = "[ @]22M^]21M^]20M^" . (' 'x605);
my $scorer3 = "[@ <]02M^]20M^]11M^" . (' 'x605);
my $popid = -10;
my @population = map { Blueprint->new( code => $_, dimensions => 4, id => $popid++, host => 'test' ) }
($quit1,$quit1,$concede1,$concede1,$dier1,$dier1,$scorer3,$scorer1,$scorer2, $scorer2);
$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');
t/09population.t view on Meta::CPAN
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);
($c1, $c2) = $population->pair(map { $$_{fitness} } (@population));
is($$c1{id}, $population[0]{id}, "pair bias works");
is($$c2{id}, $population[1]{id}, "pair bias works");
BEGIN { $num_tests += 4 };
# save
my $goodfile = IO::File->new('t/savefile');
my $subdir = tempdir(CLEANUP => 1);
my $olddir = getcwd();
chdir($subdir);
t/09population.t view on Meta::CPAN
# config
$population->generation(999);
is($population->config->config('basic_value'), 42, 'global config works');
$population->generation(1000);
is($population->config->config('basic_value'), 67, 'config overrides work');
BEGIN { $num_tests += 2 };
# breed
seed(map { oneish, 0.3, 0, 0.7, oneish, 0.5, 0.2, 0.1, 0.1, oneish, 0.4, 0, 0, 0, 0, 0 } (1..1000));
$population->breed();
@population = @{$population->blueprints};
my %accepted_sizes = (1 => 1, 256 => 1, 625 => 1, 1296 => 1);
for my $blueprint (@population) {
ok(exists($accepted_sizes{length($blueprint->code)}), "new code has reasonable length ".length($blueprint->code));
}
BEGIN { $num_tests += 10 };
# new
( run in 0.478 second using v1.01-cache-2.11-cpan-49f99fa48dc )