view release on metacpan or  search on metacpan

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

sub new {
    my ($package, %args) = @_;
    $args{Host}         = $ENV{HOST} unless defined $args{Host};
    $args{Generation} //= 1;
    $args{Blueprints} //= [];

    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()) {
            $size *= $component;
        }
        my $code .= $self->new_code_fragment($size, $config->config('initial_code_density', 90));
        my $chromosome = AI::Evolve::Befunge::Blueprint->new(code => $code, dimensions => $nd);
        push @population, $chromosome;
    }
    $$self{blueprints} = [@population];
    return $self;
}


=head2 load

    $population->load($filename);

Load a savefile, allowing you to pick up where it left off.

=cut

sub load {
    my ($package, $savefile) = @_;
    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";
        }
    }
    my $self = bless({
        host       => $host,
        blueprints => [@population],
        generation => $generation,
        migrate    => spawn_migrator(),
    }, $package);
    $self->reload_defaults();
    return $self;
}


=head1 PUBLIC METHODS

These methods are intended to be the normal user interface for this
module.  Their APIs will not change unless I find a very good reason.


=head2 reload_defaults

    $population->reload_defaults();

Rehashes the config file, pulls various values from there.  This is
common initializer code, shared by new() and load().  It defines the
values for the following items:

=over 4

=item boardsize

=item config

=item dimensions

=item physics

=item popsize

=item tokens

=back

=cut

sub reload_defaults {
    my $self = shift;
    my @config_args = (host => $self->host, gen => $self->generation);
    my $config = custom_config(@config_args);
    delete($$self{boardsize});
    my $physics        = $config->config('physics', 'ttt');
    $$self{physics}    = Physics->new($physics);
    $config            = custom_config(@config_args, physics => $self->physics->name);
    $$self{dimensions} = $config->config('dimensions', 3);
    $$self{popsize}    = $config->config('popsize', 40);

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

    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;
    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)) {
        my $cid = ${$self->blueprints}[$id]{id};
        $$self{migrate}->print(${$self->blueprints}[$id]->as_string);
        debug("exporting critter $cid\n");
    }
}


=head2 migrate_import

    $population->migrate_import();

Look on the migration network for incoming critters, and import some
if we have room left.  To prevent getting swamped, it will only allow
a total of (Popsize*1.5) critters in the array at once.  If the number
of incoming migrations exceeds that, the remainder will be left in the
Migrator receive queue to be handled the next time around.

=cut

sub migrate_import {
    my ($self) = @_;
    my $critter_limit = ($self->popsize * 1.5);
    my @new;
    my $select = IO::Select->new($$self{migrate});
    if($select->can_read(0)) {
        my $data;
        $$self{migrate}->blocking(0);
        $$self{migrate}->sysread($data, 10000);
        my $in;
        while(((scalar @{$self->blueprints} + scalar @new) < $critter_limit)
           && (($in = index($data, "\n")) > -1)) {
            my $line = substr($data, 0, $in+1, '');
            debug("migrate: importing critter\n");
            my $individual =
                AI::Evolve::Befunge::Blueprint->new_from_string($line);
            push(@new, $individual) if defined $individual;
        }
    }