view release on metacpan or  search on metacpan

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

=head1 NAME

    AI::Evolve::Befunge::Population - manage a population


=head1 SYNOPSIS

    use aliased 'AI::Evolve::Befunge::Population' => 'Population';
    use AI::Evolve::Befunge::Util qw(v nonquiet);

    $population = Population->new();

    while(1) {
        my $gen  = $population->generation;
        nonquiet("generation $gen\n");
        $population->fight();
        $population->breed();
        $population->migrate();
        $population->save();
        $population->generation($gen+1);
    }


=head1 DESCRIPTION

This manages a population of Befunge AI critters.

This is the main evolution engine for AI::Evolve::Befunge.  It has
all of the steps necessary to evolve a population and generate the
next generation.  The more times you run this process, the more
progress it will (theoretically) make.


=head1 CONSTRUCTORS

There are two constructors, depending on whether you want to create
a new population, or resume a saved one.


=head2 new

    my $population = Population->new(Generation => 50);

Creates a Population object.  The following arguments may be
specified (none are mandatory):

    Blueprints - a list (array reference) of critters.   (Default: [])
    Generation - the generation number.                   (Default: 1)
    Host - the hostname of this Population.      (Default: `hostname`)

=cut

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


=head2 fight