view release on metacpan or  search on metacpan

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

    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);
    $$self{tokens}     = $config->config('tokens', 2000);
    $$self{config}     = $config;
    $$self{boardsize}  = $$self{physics}->board_size if defined $$self{physics}->board_size;
}


=head2 fight

    $population->fight();

Determines (through a series of fights) the basic fitness of each
critter in the population.  The fight routine (see the "double_match"
method in Physics.pm) is called a bunch of times in parallel, and the
loser dies (is removed from the list).  This is repeated until the total
population has been reduced to 25% of the "popsize" setting.

=cut

sub fight {
    my $self = shift;
    my $physics    = $self->physics;
    my $popsize    = $self->popsize;

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

    $population->migrate();

Send and receive critters to/from other populations.  This requires an
external networking script to be running.

Exported critters are saved to a "migrate-$HOST/out" folder.  The
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));