AI-Gene-Sequence
view release on metacpan or search on metacpan
0.20 Tue Jan 02 23:20:00 2001
Changes name changed to AI::Gene::*
speed warnings added to pod
0.13 Sat Dec 30 23:00:00 2000
Added: mutate_reverse method added to both Sequence and Simple
BUGFIXES: modified makefile to ensure sensible version of perl
removed eval in mutate method and _normalise
0.12 Fri Dec 29 19:00:00 2000
Added: Genetics::Gene::Simple package added, with tests (tsimp.t)
BUGFIXES: require 5.6.0 lines.
documentation made clearer.
0.11 Thu Dec 28 21:00:00 2000
Makefile.PL view on Meta::CPAN
# Perl version checking
eval {require 5.6.0} or die <<'EOD';
* This module uses functions which are only available in perls
* greater than 5.6.0 which you do not seem to have yet.
EOD
use ExtUtils::MakeMaker;
# See lib/ExtUtils/MakeMaker.pm for details of how to influence
# the contents of the Makefile that is written.
WriteMakefile(
'NAME' => 'AI::Gene::Sequence',
'VERSION_FROM' => 'AI/Gene/Sequence.pm', # finds $VERSION
demo/Musicgene.pm view on Meta::CPAN
my $num_mutates = +$_[0] || 1;
my $rt = 0;
my ($hr_probs, $muts);
if (ref $_[1] eq 'HASH') { # use non standard mutations or probs
$hr_probs = $self->_normalise($_[1]);
$muts = [keys %{$hr_probs}];
MUT_CYCLE: for (1..$num_mutates) {
my $rand = rand;
foreach my $mutation (@{$muts}) {
next unless $rand < $hr_probs->{$mutation};
$rt += eval "\$self->mutate_$mutation(1)";
next MUT_CYCLE;
}
}
}
else { # use standard mutations and probs
foreach (1..$num_mutates) {
my $rand = rand;
if ($rand < $probs{insert}) {
$rt += $self->mutate_insert(1);
}
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,7); # outside of gene
ok($rt,0);
ok($gene->g eq 'defghij');
$rt = $gene->mutate_remove(1,5,5); # extends beyond gene
ok($rt,1);
ok($gene->g eq 'defgh');
# 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');
ok($rt,1);
ok($gene->d ne 'abcdefghij');
$gene = $main->clone;
$rt = $gene->mutate_insert(1,11); # outside of gene
ok($rt,0);
ok($gene->g eq 'abcdefghij');
# 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, 'abcdefghij');
$gene = $main->clone;
$rt = $gene->mutate_overwrite(1,11,4); # area to copy lies outside gene
ok($rt,0);
ok($gene->g, 'abcdefghij');
ok($gene->d, 'abcdefghij');
# 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, 'abcdefghij');
$gene = $main->clone;
$rt = $gene->mutate_reverse(1,10,1); # starts outside gene
ok($rt,0);
ok($gene->d, 'abcdefghij');
ok($gene->g, 'abcdefghij');
# 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');
ok($rt,1);
ok($gene->g, 'abcdefghija');
$gene = $main->clone;
$rt = $gene->mutate_duplicate(1,0,10,10); # double the gene
ok($rt,1);
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;
ok($rt,0);
ok($gene->g, 'abcdefghij');
$gene = $main->clone;
$rt = $gene->mutate_switch(1,0,2,5,3); # overlap of sections
ok($rt,0);
ok($gene->g, 'abcdefghij');
# hammer randomness
$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($rt,1);
ok($gene->g, 'fghabcdeij');
$gene = $main->clone;
$rt = $gene->mutate_shuffle(1,8,5,5); # extends beyond gene
ok($rt,0);
ok($gene->g, 'abcdefghij');
# 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 = (
insert =>1,
remove =>1,
duplicate =>1,
overwrite =>1,
minor =>1,
major =>1,
switch =>1,
shuffle =>1,
);
$rt = 0;
for (1..$hammer) {
my $gene= $main->clone;
eval '$gene->mutate(1, \\%probs)';
$rt = 1 if $@;
}
ok($rt,0);
}
1;
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,7); # outside of gene
ok($rt,0);
ok($gene->d eq 'defghij');
$rt = $gene->mutate_remove(1,5,5); # extends beyond gene
ok($rt,1);
ok($gene->d eq 'defgh');
# 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');
ok($rt,1);
ok($gene->d ne 'abcdefghij');
$gene = $main->clone;
$rt = $gene->mutate_insert(1,11); # outside of gene
ok($rt,0);
ok($gene->d eq 'abcdefghij');
# 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');
ok($rt,0);
ok($gene->d, 'abcdefghij');
$gene = $main->clone;
$rt = $gene->mutate_overwrite(1,11,4); # area to copy lies outside gene
ok($rt,0);
ok($gene->d, 'abcdefghij');
# 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($rt,0);
ok($gene->d, 'abcdefghij');
$gene = $main->clone;
$rt = $gene->mutate_reverse(1,10,1); # starts outside gene
ok($rt,0);
ok($gene->d, 'abcdefghij');
# 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');
ok($rt,1);
ok($gene->d, 'abcdefghija');
$gene = $main->clone;
$rt = $gene->mutate_duplicate(1,0,10,10); # double the gene
ok($rt,1);
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;
ok($rt,0);
ok($gene->d, 'abcdefghij');
$gene = $main->clone;
$rt = $gene->mutate_switch(1,0,2,5,3); # overlap of sections
ok($rt,0);
ok($gene->d, 'abcdefghij');
# hammer randomness
$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($rt,1);
ok($gene->d, 'fghabcdeij');
$gene = $main->clone;
$rt = $gene->mutate_shuffle(1,8,5,5); # extends beyond gene
ok($rt,0);
ok($gene->d, 'abcdefghij');
# 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 = (
insert =>1,
remove =>1,
duplicate =>1,
overwrite =>1,
minor =>1,
major =>1,
switch =>1,
shuffle =>1,
);
$rt = 0;
for (1..$hammer) {
my $gene= $main->clone;
eval '$gene->mutate(1, \\%probs)';
$rt = 1 if $@;
}
ok($rt,0);
}
1;
( run in 1.379 second using v1.01-cache-2.11-cpan-acf6aa7dc9e )