view release on metacpan or  search on metacpan

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

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.

=cut

sub migrate {
    my $self = shift;
    $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();
    unlink($fn);
    rename("$fn.tmp",$fn);
    $self->cleanup_intermediate_savefiles();
}


=head1 INTERNAL METHODS

The APIs of the following methods may change at any time.


=head2 mutate

    $population->mutate($blueprint);

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));
    }
    $blueprint->code($code);
    delete($$blueprint{cache});
}


=head2 crossover

    $population->crossover($blueprint1, $blueprint2);

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)) {
        my $pos = 0;
        for my $d (0..$v->get_dims()-1) {
            $pos *= $code_size->get_component($d);
            $pos += $v->get_component($d);
        }
        my $tmp = vec($code2,$pos,8);
        vec($code2,$pos,8) = vec($code1,$pos,8);
        vec($code1,$pos,8) = $tmp;
    }
    $chr1->code($code1);
    $chr2->code($code2);
    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;
    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);
}


=head2 grow

    $population->grow($blueprint);

Possibly (1 in 10 chance) increase the size of a blueprint.  Each side
of the hypercube shall have its length increased by 1.  The original
code will begin at the origin, so that the same code executes first.

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