• Your recent searches
AI-Evolve-Befunge
6 results

 view release on metacpan or  search on metacpan

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

60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
    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 

55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
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 

77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
        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 

215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
    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 

353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
$$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 

448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
# 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 

78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
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 

210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
 
=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 

273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
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 

366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
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 

398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
 
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 

446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
=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 

484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
 
=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 

647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
            $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.

t/06util.t  view on Meta::CPAN 

51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
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 

172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
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 

201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
    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 

248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
 
# 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.571 second using v1.01-cache-2.11-cpan-a9ef4e587e4 )