AI-Gene-Sequence
view release on metacpan or search on metacpan
AI/Gene/Sequence.pm view on Meta::CPAN
sub render {
my $self = shift;
return join(' ', @{$self->[1]});
}
# elsewhere
package main;
my $gene = Somegene->new;
$gene->seed;
print $gene->render, "\n";
$gene->mutate(5);
print $gene->render, "\n";
$gene->mutate(5);
print $gene->render, "\n";
=head1 DESCRIPTION
This is a class which provides generic methods for the
creation and mutation of genetic sequences. Various mutations
are provided as is a way to ensure that genes created by
mutations remain useful (for instance, if a gene gives rise to
code, it can be tested for correct syntax).
If you do not need to keep check on what sort of thing is
AI/Gene/Simple.pm view on Meta::CPAN
$self->[0][$_] = rand(1) * 10 for (0..$_[0]);
return $self;
}
# ... then elsewhere
package main;
my $gene = Somegene->new;
$gene->seed(5);
print $gene->calculate(2), "\n";
$gene->mutate_minor;
print $gene->calculate(2), "\n";
$gene->mutate_major;
print $gene->calculate(2), "\n";
=head1 DESCRIPTION
This is a class which provides generic methods for the
creation and mutation of genetic sequences. Various mutations
are provided but the resulting mutations are not checked
for a correct syntax. These classes are suitable for genes
where it is only necessary to know what lies at a given
position in a gene. If you need to ensure a gene maintains
a sensible grammar, then you should use the AI::Gene::Sequence
demo/Regexgene.pm view on Meta::CPAN
Regexgene - An example of a AI::Gene::Sequence
=head1 SYNOPSIS
This is a short module which illustrates the way to use the
AI::Gene::Sequence module.
use Regexgene;
$regex = Regexgene->new(5);
print $regex->regex, "\n";
$regex->mutate;
print $regex->regex, "\n";
$copy = $regex->clone;
$copy->mutate;
print $regex->regex, "\n", $copy->regex, "\n";
=head1 DESCRIPTION
The following is a code / pod mix, use the source. A programme
using this module is available as C<spamscan.pl>.
=head1 The module code
=cut
demo/music.pl view on Meta::CPAN
use strict;
use warnings;
use Musicgene;
# make something to start from
my @seeds;
for (0..9) {
$seeds[$_] = Musicgene->new(20);
print "$_ : ", ($seeds[$_]->_test_dump)[0], "\n";
$seeds[$_]->write_file('music'.$_.'.mid');
}
print "Enter number to retain (0-9):";
while (<>) {
chomp;
last if /\D/;
$seeds[0] = $seeds[$_];
$seeds[0]->write_file('music0.mid');
print "\n0: ", ($seeds[0]->_test_dump)[0], "\n";
for (1..9) {
$seeds[$_] = $seeds[0]->clone; # make some children
$seeds[$_]->mutate(5); # modify them a bit
$seeds[$_]->write_file('music'.$_.'.mid');
print "$_: ", ($seeds[$_]->_test_dump)[0], "\n";
}
print "Enter number to retain (0-9):";
}
demo/spamscan.pl view on Meta::CPAN
#!/usr/bin/perl -w
# spamscan.pl by Alex Gough, 2001, (alex@rcon.org)
# This is a quick illustration of the Regexgene pseudo- module which
# is itself an illustration of the AI::Gene::Sequence module.
#
# It will run for ever, printing out dots or regular expressions
# which are quite good at spotting spam.
use strict;
use warnings;
use Regexgene;
my $num_mutates = 3;
# read in our passes and failures.
my (@wanted, @spam);
while (<DATA>) {
if (1../^$/) { push @wanted, $_;}
else { push @spam, $_}
}
print "Best score possible is: ", scalar(@spam), "\n";
my $regex = seed_match(); # start off with something quite good
my $best_yet = 0;
my $temp = 1;
while (1) {
my $child = $regex->clone; # copy the parent
$child->mutate($num_mutates); # change it slightly
my $rex = $child->regex;
$rex = qr/$rex/;
my $score = 0; # see if the kid is better
$score += grep {$_ =~ $rex} @spam; # we don't want spam
$score -= grep {$_ =~ $rex} @wanted; # but we do want our mail
if ($score > $best_yet) {
$regex = $child; # and so progress is made
$best_yet = $score;
print "\n* $best_yet ", $regex->regex, "\n";
}
print '.' unless ($temp++ % 80);
}
sub seed_match {
my $regex;
TWIDDLE: while (1) {
$regex = Regexgene->new(5);
my $rg = $regex->regex;
last TWIDDLE if $spam[rand@spam] =~ $rg;
}
return $regex;
{ # test1
# first of all, does our testing package behave
my $gene = GTest->new;
die "$0: Broken render" unless $gene->d eq 'abcdefghij'
and $gene->g eq 'abcdefghij';
die "$0: Broken generate" unless ($gene->generate_token('a'))[1] eq 'A'
and ($gene->generate_token())[0] eq 'n';
ok(1);
}
my $main = GTest->new;
{ print "# clone\n";
my $gene = $main->clone;
ok($gene->g, $main->g);
}
{ print "# mutate_minor\n";
my $gene = $main->clone;
my $rt = $gene->mutate_minor(1);
ok ($rt, 1); # return value
ok ($gene->g ne $main->g); # changed
$gene = $main->clone;
$gene->mutate_minor(1,0);
ok ($gene->g, 'Abcdefghij');
$rt = $gene->mutate_minor(1,10); # outside of gene
ok ($rt,0);
ok ($gene->g, 'Abcdefghij');
# hammer randomness, check for errors
$rt = 0;
for (1..$hammer) {
eval '$gene->mutate_minor()';
$rt = 1 if $@;
}
ok($rt,0);
}
{ print "# mutate_major\n";
my $gene = $main->clone;
my $rt = $gene->mutate_major(1,0);
ok($rt, 1);
ok($gene->g, 'Nbcdefghij');
$gene = $main->clone;
$gene->mutate_major;
ok($gene->g ne $main->g, 1);
$gene = $main->clone;
$rt = $gene->mutate_major(1,10); # outside of gene
ok($rt,0);
ok($gene->g eq $main->g);
# hammer randomness
$rt = 0;
for (1..$hammer) {
eval '$gene->mutate_major()';
$rt = 1 if $@;
}
ok($rt,0);
}
{ print "# mutate_remove\n";
my $gene = $main->clone;
my $rt = $gene->mutate_remove(1,0);
ok($rt,1);
ok($gene->g eq 'bcdefghij' and $gene->d eq 'bcdefghij');
$rt = $gene->mutate_remove(1,0,2);
ok($rt,1);
ok($gene->g eq 'defghij' and $gene->d eq 'defghij');
$rt = $gene->mutate_remove(1,7); # outside of gene
ok($rt,0);
ok($gene->g eq 'defghij');
# hammer randomness
$rt = 0;
for (1..$hammer) {
$gene = $main->clone;
eval '$gene->mutate_remove(1,undef,0)';
$rt = 1 if $@;
}
ok($rt,0);
}
{ print "# mutate_insert\n";
my $gene = $main->clone;
my $rt = $gene->mutate_insert(1,0);
ok($rt,1);
ok($gene->g eq 'Nabcdefghij' and $gene->d eq 'nabcdefghij');
$gene = $main->clone;
$rt = $gene->mutate_insert(1,10); # last possible pos
ok($rt,1);
ok($gene->d eq 'abcdefghijn' and $gene->g eq 'abcdefghijN');
$gene = $main->clone;
$rt = $gene->mutate_insert;
# hammer randomness
$rt = 0;
for (1..$hammer) {
$gene = $main->clone;
eval '$gene->mutate_insert';
$rt = 1 if $@;
}
ok($rt,0);
}
{ print "# mutate_overwrite\n";
my $gene = $main->clone;
my $rt = $gene->mutate_overwrite(1,0,1); # first to second
ok($rt,1);
ok($gene->g, 'aacdefghij');
ok($gene->d, 'aacdefghij');
$gene = $main->clone;
$rt = $gene->mutate_overwrite(1,0,4,3); # has length
ok($rt,1);
ok($gene->g, 'abcdabchij');
ok($gene->d, 'abcdabchij');
# hammer randomness
$rt = 0;
for (1..$hammer) {
$gene = $main->clone;
eval '$gene->mutate_overwrite(1,undef,undef,0)';
$rt = 1 if $@;
}
ok($rt,0);
}
{ print "# mutate_reverse\n";
my $gene = $main->clone;
my $rt = $gene->mutate_reverse(1,0,2);
ok($rt,1);
ok($gene->d, 'bacdefghij');
ok($gene->g, 'bacdefghij');
$gene = $main->clone;
$rt = $gene->mutate_reverse(1,0,10); # whole gene
ok($rt,1);
ok($gene->d, 'jihgfedcba');
ok($gene->g, 'jihgfedcba');
# hammer randomness
$rt = 0;
for (1..$hammer) {
$gene = $main->clone;
eval '$gene->mutate_reverse(1,undef,0)';
$rt = 1 if $@;
}
ok($rt,0);
}
{ print "# mutate_duplicate\n";
my $gene = $main->clone;
my $rt = $gene->mutate_duplicate(1,0,0);
ok($rt,1);
ok($gene->g, 'aabcdefghij');
$gene = $main->clone;
$rt = $gene->mutate_duplicate(1,9,0); # from end of gene to front
ok($rt,1);
ok($gene->g, 'jabcdefghij');
$gene = $main->clone;
$rt = $gene->mutate_duplicate(1,10,0); # from outside of gene
ok($gene->g, 'abcdefghijabcdefghij');
# hammer randomness
$rt = 0;
for (1..$hammer) {
$gene = $main->clone;
eval '$gene->mutate_duplicate(1,undef,undef,0)';
}
ok($rt,0);
}
{ print "# mutate_switch\n";
my $gene = $main->clone;
my $rt = $gene->mutate_switch(1,0,9); # first and last
ok($rt,1);
ok($gene->g, 'jbcdefghia');
$gene = $main->clone;
$rt = $gene->mutate_switch(1,0,8,2,2); # 1st 2 and last 2
ok($rt,1);
ok($gene->g, 'ijcdefghab');
$gene = $main->clone;
$rt = $gene->mutate_switch(1,0,5,2,4); # different lengths
$rt = 0;
for (1..$hammer) {
$gene = $main->clone;
eval '$gene->mutate_switch(1,undef,undef,0,0)';
$rt = 1 if $@;
}
ok($rt,0);
}
{ print "# mutate_shuffle\n";
my $gene = $main->clone;
my $rt = $gene->mutate_shuffle(1,5,0); # from after to
ok($rt,1);
ok($gene->g, 'fabcdeghij');
$gene = $main->clone;
$rt = $gene->mutate_shuffle(1,5,0,2); # extended sequence
ok($rt,1);
ok($gene->g, 'fgabcdehij');
$gene = $main->clone;
$rt = $gene->mutate_shuffle(1,0,5,2); # to after from
# hammer randomness
$rt = 0;
for (1..$hammer) {
$gene = $main->clone;
eval '$gene->mutate_shuffle(1,undef,undef,0)';
$rt = 1 if $@;
}
ok($rt,0);
}
{ print "# mutate\n";
my $rt = 0;
# hammer with defaults
for (1..$hammer) {
my $gene = $main->clone;
eval '$gene->mutate';
$rt = 1 if $@;
}
ok($rt,0);
# hammer with custom probs
my %probs = (
{ # test1
# first of all, does our testing package behave
my $gene = GTestS->new;
die "$0: Broken render" unless $gene->d eq 'abcdefghij';
die "$0: Broken generate" unless $gene->generate_token('a') eq 'A'
and $gene->generate_token eq 'N';
ok(1);
}
my $main = GTestS->new;
{ print "# clone\n";
my $gene = $main->clone;
ok($gene->d, $main->d);
}
{ print "# mutate_minor\n";
my $gene = $main->clone;
my $rt = $gene->mutate_minor(1);
ok ($rt, 1); # return value
ok ($gene->d ne $main->d); # changed
$gene = $main->clone;
$gene->mutate_minor(1,0);
ok ($gene->d, 'Abcdefghij');
$rt = $gene->mutate_minor(1,10); # outside of gene
ok ($rt,0);
ok ($gene->d, 'Abcdefghij');
# hammer randomness, check for errors
$rt = 0;
for (1..$hammer) {
eval '$gene->mutate_minor()';
$rt = 1 if $@;
}
ok($rt,0);
}
{ print "# mutate_major\n";
my $gene = $main->clone;
my $rt = $gene->mutate_major(1,0);
ok($rt, 1);
ok($gene->d, 'Nbcdefghij');
$gene = $main->clone;
$gene->mutate_major;
ok($gene->d ne $main->d);
$gene = $main->clone;
$rt = $gene->mutate_major(1,10); # outside of gene
ok($rt,0);
ok($gene->d eq $main->d);
# hammer randomness
$rt = 0;
for (1..$hammer) {
eval '$gene->mutate_major()';
$rt = 1 if $@;
}
ok($rt,0);
}
{ print "# mutate_remove\n";
my $gene = $main->clone;
my $rt = $gene->mutate_remove(1,0);
ok($rt,1);
ok($gene->d eq 'bcdefghij');
$rt = $gene->mutate_remove(1,0,2);
ok($rt,1);
ok($gene->d eq 'defghij');
$rt = $gene->mutate_remove(1,7); # outside of gene
ok($rt,0);
ok($gene->d eq 'defghij');
# hammer randomness
$rt = 0;
for (1..$hammer) {
$gene = $main->clone;
eval '$gene->mutate_remove(1,undef,0)';
$rt = 1 if $@;
}
ok($rt,0);
}
{ print "# mutate_insert\n";
my $gene = $main->clone;
my $rt = $gene->mutate_insert(1,0);
ok($rt,1);
ok($gene->d eq 'Nabcdefghij');
$gene = $main->clone;
$rt = $gene->mutate_insert(1,10); # last possible pos
ok($rt,1);
ok($gene->d eq 'abcdefghijN');
$gene = $main->clone;
$rt = $gene->mutate_insert;
# hammer randomness
$rt = 0;
for (1..$hammer) {
$gene = $main->clone;
eval '$gene->mutate_insert';
$rt = 1 if $@;
}
ok($rt,0);
}
{ print "# mutate_overwrite\n";
my $gene = $main->clone;
my $rt = $gene->mutate_overwrite(1,0,1); # first to second
ok($rt,1);
ok($gene->d, 'aacdefghij');
$gene = $main->clone;
$rt = $gene->mutate_overwrite(1,0,4,3); # has length
ok($rt,1);
ok($gene->d, 'abcdabchij');
$gene = $main->clone;
$rt = $gene->mutate_overwrite(1,3,4,3); # overlap
# hammer randomness
$rt = 0;
for (1..$hammer) {
$gene = $main->clone;
eval '$gene->mutate_overwrite(1,undef,undef,0)';
$rt = 1 if $@;
}
ok($rt,0);
}
{ print "# mutate_reverse\n";
my $gene = $main->clone;
my $rt = $gene->mutate_reverse(1,0,2);
ok($rt,1);
ok($gene->d, 'bacdefghij');
$gene = $main->clone;
$rt = $gene->mutate_reverse(1,0,10); # whole gene
ok($rt,1);
ok($gene->d, 'jihgfedcba');
$gene = $main->clone;
$rt = $gene->mutate_reverse(1,8,4); # extends beyond gene
# hammer randomness
$rt = 0;
for (1..$hammer) {
$gene = $main->clone;
eval '$gene->mutate_reverse(1,undef,0)';
$rt = 1 if $@;
}
ok($rt,0);
}
{ print "# mutate_duplicate\n";
my $gene = $main->clone;
my $rt = $gene->mutate_duplicate(1,0,0);
ok($rt,1);
ok($gene->d, 'aabcdefghij');
$gene = $main->clone;
$rt = $gene->mutate_duplicate(1,9,0); # from end of gene to front
ok($rt,1);
ok($gene->d, 'jabcdefghij');
$gene = $main->clone;
$rt = $gene->mutate_duplicate(1,10,0); # from outside of gene
ok($gene->d, 'abcdefghijabcdefghij');
# hammer randomness
$rt = 0;
for (1..$hammer) {
$gene = $main->clone;
eval '$gene->mutate_duplicate(1,undef,undef,0)';
}
ok($rt,0);
}
{ print "# mutate_switch\n";
my $gene = $main->clone;
my $rt = $gene->mutate_switch(1,0,9); # first and last
ok($rt,1);
ok($gene->d, 'jbcdefghia');
$gene = $main->clone;
$rt = $gene->mutate_switch(1,0,8,2,2); # 1st 2 and last 2
ok($rt,1);
ok($gene->d, 'ijcdefghab');
$gene = $main->clone;
$rt = $gene->mutate_switch(1,0,5,2,4); # different lengths
$rt = 0;
for (1..$hammer) {
$gene = $main->clone;
eval '$gene->mutate_switch(1,undef,undef,0,0)';
$rt = 1 if $@;
}
ok($rt,0);
}
{ print "# mutate_shuffle\n";
my $gene = $main->clone;
my $rt = $gene->mutate_shuffle(1,5,0); # from after to
ok($rt,1);
ok($gene->d, 'fabcdeghij');
$gene = $main->clone;
$rt = $gene->mutate_shuffle(1,5,0,2); # extended sequence
ok($rt,1);
ok($gene->d, 'fgabcdehij');
$gene = $main->clone;
$rt = $gene->mutate_shuffle(1,0,5,2); # to after from
# hammer randomness
$rt = 0;
for (1..$hammer) {
$gene = $main->clone;
eval '$gene->mutate_shuffle(1,undef,undef,0)';
$rt = 1 if $@;
}
ok($rt,0);
}
{ print "# mutate\n";
my $rt = 0;
# hammer with defaults
for (1..$hammer) {
my $gene = $main->clone;
eval '$gene->mutate';
$rt = 1 if $@;
}
ok($rt,0);
# hammer with custom probs
my %probs = (
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'
######################### We start with some black magic to print on failure.
# Change 1..1 below to 1..last_test_to_print .
# (It may become useful if the test is moved to ./t subdirectory.)
BEGIN { $| = 1; print "1..1\n"; }
END {print "not ok 1\n" unless $loaded;}
use AI::Gene::Sequence;
use AI::Gene::Simple;
$loaded = 1;
print "ok 1\n";
######################### End of black magic.
# Insert your test code below (better if it prints "ok 13"
# (correspondingly "not ok 13") depending on the success of chunk 13
# of the test code):
( run in 1.059 second using v1.01-cache-2.11-cpan-de7293f3b23 )