view release on metacpan or  search on metacpan

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

        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);
    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);
    }
    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
savefile-4120
savefile-4121
savefile-4122
savefile-4123

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;