AI-Evolve-Befunge

 view release on metacpan or  search on metacpan

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

    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

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

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

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

            my $individual =
                AI::Evolve::Befunge::Blueprint->new_from_string($line);
            push(@new, $individual) if defined $individual;
        }
    }
    $self->blueprints([@{$self->blueprints}, @new])
        if scalar @new;
}


=head2 new_code_fragment

    my $trash = $population->new_code_fragment($length, $density);

Generate $length bytes of random Befunge code.  The $density parameter
controls the ratio of code to whitespace, and is given as a percentage.
Density=0 will return all spaces; density=100 will return no spaces.

=cut

sub new_code_fragment {
    my ($self, $length, $density) = @_;
    my @safe = ('0'..'9', 'a'..'h', 'j'..'n', 'p'..'z', '{', '}', '`', '_',
                '!', '|', '?', '<', '>', '^', '[', ']', ';', '@', '#', '+',
                '/', '*', '%', '-', ':', '$', '\\' ,'"' ,"'");

    my $usage = 'Usage: $population->new_code_fragment($length, $density);';
    croak($usage) unless ref($self);
    croak($usage) unless defined($length);
    croak($usage) unless defined($density);
    my $physics = $self->physics;
    push(@safe, sort keys %{$$physics{commands}})
        if exists $$physics{commands};
    my $rv = '';
    foreach my $i (1..$length) {
        my $chr = ' ';
        if(rand()*100 < $density) {

t/09population.t  view on Meta::CPAN

is($population->generation, 1, 'default generation');
BEGIN { $num_tests += 9 };


# default blueprints
my $listref = $population->blueprints;
is(scalar @$listref, 10, 'default blueprints created');
foreach my $i (0..7) {
    my $individual = $$listref[$i];
    my $code = $individual->code;
    is(index($code, "\0"), -1, "new_code_fragment contains no nulls");
    is(length($code), 256, "newly created blueprints have right code size");
}
BEGIN { $num_tests += 17 };


# new_code_fragment
seed(0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my $code = $population->new_code_fragment(10, 0);
is(index($code, "\0"), -1, "new_code_fragment contains no nulls");
is(length($code), 10, "new_code_fragment obeys length parameter");
is($code, ' 'x10, 'prob=0 means I get a blank line');
seed(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
$code = $population->new_code_fragment(10, 100);
is(index($code, "\0"), -1, "new_code_fragment contains no nulls");
is(length($code), 10, "new_code_fragment obeys length parameter");
is($code, '0'x10, 'prob=100 means I get a line of code');
seed(oneish, oneish, oneish, oneish, oneish, oneish, oneish, oneish);
is($population->new_code_fragment( 4, 120), 'TTTT', 'Physics-specific commands are generated');
seed(oneish, oneish, oneish, oneish, oneish, oneish, oneish, oneish);
is($population2->new_code_fragment(4, 120), "''''", 'No Physics-specific commands are generated when the Physics has none.');
dies_ok(sub { AI::Evolve::Befunge::Population::new_code_fragment(1) }, "no self ptr");
dies_ok(sub { $population->new_code_fragment()  }, "no length");
dies_ok(sub { $population->new_code_fragment(5) }, "no density");
BEGIN { $num_tests += 11 };


# mutate
my $blank = Blueprint->new( code => " "x256, dimensions => 4, id => -10 );
seed(0.3,0,0,0,0,0,0,0);
$population->mutate($blank);
is($blank->code, " "x64 . "0"x192, 'big mutate');
$blank->code(" "x256);
seed(0,0,0,0,oneish,oneish,oneish,oneish);