AI-Gene-Sequence
view release on metacpan or search on metacpan
AI/Gene/Sequence.pm view on Meta::CPAN
##
# inserts one element into the sequence
# 0: number to perform ( or 1)
# 1: position to mutate (undef for random)
sub mutate_insert {
my $self = shift;
my $num = +$_[0] || 1;
my $rt = 0;
for (1..$num) {
my $length = length $self->[0];
my $pos = defined($_[1]) ? $_[1] : int rand $length;
next if $pos > $length; # further than 1 place after gene
my @token = $self->generate_token;
my $new = $self->[0];
substr($new, $pos, 0) = $token[0];
next unless $self->valid_gene($new, $pos);
$self->[0] = $new;
splice @{$self->[1]}, $pos, 0, $token[1];
$rt++;
}
return $rt;
}
##
# removes element(s) from sequence
# 0: number of times to perform
# 1: position to affect (undef for rand)
# 2: length to affect, undef => 1, 0 => random length
sub mutate_remove {
my $self = shift;
my $num = +$_[0] || 1;
my $rt = 0;
for (1..$num) {
my $length = length $self->[0];
my $len = !defined($_[2]) ? 1 : ($_[2] || int rand $length);
next if ($length - $len) <= 0;
my $pos = defined($_[1]) ? $_[1] : int rand $length;
next if $pos >= $length; # outside of gene
my $new = $self->[0];
substr($new, $pos, $len) = '';
next unless $self->valid_gene($new, $pos);
$self->[0] = $new;
splice @{$self->[1]}, $pos, $len;
$rt++;
}
return $rt;
}
##
# copies an element or run of elements into a random place in the gene
# 0: number to perform (or 1)
# 1: posn to copy from (undef for rand)
# 2: posn to splice in (undef for rand)
# 3: length (undef for 1, 0 for random)
sub mutate_duplicate {
my $self = shift;
my $num = +$_[0] || 1;
my $rt = 0;
for (1..$num) {
my $length = length $self->[0];
my $len = !defined($_[3]) ? 1 : ($_[3] || int rand $length);
my $pos1 = defined($_[1]) ? $_[1] : int rand $length;
my $pos2 = defined($_[2]) ? $_[2] : int rand $length;
my $new = $self->[0];
next if ($pos1 + $len) > $length;
next if $pos2 > $length;
my $seq = substr($new, $pos1, $len);
substr($new, $pos2,0) = $seq;
next unless $self->valid_gene($new);
$self->[0] = $new;
splice @{$self->[1]}, $pos2, 0, @{$self->[1]}[$pos1..($pos1+$len-1)];
$rt++;
}
return $rt;
}
##
# Duplicates a sequence and writes it on top of some other position
# 0: num to perform (or 1)
# 1: pos to get from (undef for rand)
# 2: pos to start replacement (undef for rand)
# 3: length to operate on (undef => 1, 0 => rand)
sub mutate_overwrite {
my $self = shift;
my $num = +$_[0] || 1;
my $rt = 0;
for (1..$num) {
my $new = $self->[0];
my $length = length $self->[0];
my $len = !defined($_[3]) ? 1 : ($_[3] || int rand $length);
my $pos1 = defined($_[1]) ? $_[1] : int rand $length;
my $pos2 = defined($_[2]) ? $_[2] : int rand $length;
next if ( ($pos1 + $len) >= $length
or $pos2 > $length);
substr($new, $pos2, $len) = substr($new, $pos1, $len);
next unless $self->valid_gene($new);
$self->[0] = $new;
splice (@{$self->[1]}, $pos2, $len,
@{$self->[1]}[$pos1..($pos1+$len-1)] );
$rt++;
}
return $rt;
}
##
# Takes a run of tokens and reverses their order, is a noop with 1 item
# 0: number to perform
# 1: posn to start from (undef for rand)
# 2: length (undef=>1, 0=>rand)
sub mutate_reverse {
my $self = shift;
my $num = +$_[0] || 1;
my $rt = 0;
for (1..$num) {
my $length = length $self->[0];
my $new = $self->[0];
my $pos = defined($_[1]) ? $_[1] : int rand $length;
my $len = !defined($_[2]) ? 1 : ($_[2] || int rand $length);
next if ($pos >= $length
or $pos + $len > $length);
my $chunk = reverse split('', substr($new, $pos, $len));
substr($new, $pos, $len) = join('', $chunk);
next unless $self->valid_gene($new);
$self->[0] = $new;
splice (@{$self->[1]}, $pos, $len,
reverse( @{$self->[1]}[$pos..($pos+$len-1)] ));
$rt++;
}
return $rt;
AI/Gene/Sequence.pm view on Meta::CPAN
##
# Changes token into one of same type (ie. passes type to generate..)
# 0: number to perform
# 1: position to affect (undef for rand)
sub mutate_minor {
my $self = shift;
my $num = +$_[0] || 1;
my $rt = 0;
for (1..$num) {
my $pos = defined $_[1] ? $_[1] : int rand length $self->[0];
next if $pos >= length($self->[0]); # pos lies outside of gene
my $type = substr($self->[0], $pos, 1);
my @token = $self->generate_token($type, $self->[1][$pos]);
# still need to check for niceness, just in case
if ($token[0] eq $type) {
$self->[1][$pos] = $token[1];
}
else {
my $new = $self->[0];
substr($new, $pos, 1) = $token[0];
next unless $self->valid_gene($new, $pos);
AI/Gene/Sequence.pm view on Meta::CPAN
##
# Changes one token into some other token
# 0: number to perform
# 1: position to affect (undef for random)
sub mutate_major {
my $self = shift;
my $num = +$_[0] || 1;
my $rt = 0;
for (1..$num) {
my $pos = defined $_[1] ? $_[1] : int rand length $self->[0];
next if $pos >= length($self->[0]); # outside of gene
my @token = $self->generate_token();
my $new = $self->[0];
substr($new, $pos, 1) = $token[0];
next unless $self->valid_gene($new, $pos);
$self->[0] = $new;
$self->[1][$pos] = $token[1];
$rt++;
}
return $rt;
}
##
# swaps over two sequences within the gene
# any sort of oddness can occur if regions overlap
# 0: number to perform
# 1: start of first sequence (undef for rand)
# 2: start of second sequence (undef for rand)
# 3: length of first sequence (undef for 1, 0 for rand)
# 4: length of second sequence (undef for 1, 0 for rand)
sub mutate_switch {
my $self = shift;
my $num = $_[0] || 1;
my $rt = 0;
for (1..$num) {
my $length = length $self->[0];
my $pos1 = defined $_[1] ? $_[1] : int rand $length;
my $pos2 = defined $_[2] ? $_[2] : int rand $length;
my $len1 = !defined($_[3]) ? 1 : ($_[3] || int rand $length);
my $len2 = !defined($_[4]) ? 1 : ($_[4] || int rand $length);
my $new = $self->[0];
next if $pos1 == $pos2;
if ($pos1 > $pos2) { # ensure $pos1 comes first
($pos1, $pos2) = ($pos2, $pos1);
($len1, $len2) = ($len2, $len1);
}
if ( ($pos1 + $len1) > $pos2 # ensure no overlaps
or ($pos2 + $len2) > $length
or $pos1 >= $length ) {
next;
}
my $chunk1 = substr($new, $pos1, $len1, substr($new, $pos2, $len2,''));
substr($new,$pos2 -$len1 + $len2,0) = $chunk1;
next unless $self->valid_gene($new);
$self->[0]= $new;
my @chunk1 = splice(@{$self->[1]}, $pos1, $len1,
splice(@{$self->[1]}, $pos2, $len2) );
splice @{$self->[1]}, $pos2 + $len2 - $len1,0, @chunk1;
$rt++;
}
return $rt;
}
##
# takes a sequence, removes it, then inserts it at another position
# odd things might occur if posn to replace to lies within area taken from
# 0: number to perform
# 1: posn to get from (undef for rand)
# 2: posn to put (undef for rand)
# 3: length of sequence (undef for 1, 0 for rand)
sub mutate_shuffle {
my $self = shift;
my $num = +$_[0] || 1;
my $rt = 0;
for (1..$num) {
my $length = length $self->[0];
my $pos1 = defined($_[1]) ? $_[1] : int rand $length;
my $pos2 = defined($_[2]) ? $_[2] : int rand $length;
my $len = !defined($_[3]) ? 1 : ($_[3] || int rand $length);
my $new = $self->[0];
if ($pos1 +$len > $length # outside gene
or $pos2 >= $length # outside gene
or ($pos2 < ($pos1 + $len) and $pos2 > $pos1)) { # overlap
next;
}
if ($pos1 < $pos2) {
substr($new, $pos2-$len,0) = substr($new, $pos1, $len, '');
}
else {
substr($new, $pos2, 0) = substr($new, $pos1, $len, '');
}
next unless $self->valid_gene($new);
AI/Gene/Sequence.pm view on Meta::CPAN
=item render_gene
=back
=head2 Mutation methods
Mutation methods are all named C<mutate_*>. In general, the
first argument will be the number of mutations required, followed
by the positions in the genes which should be affected, followed
by the lengths of sequences within the gene which should be affected.
If positions are not defined, then random ones are chosen. If
lengths are not defined, a length of 1 is assumed (ie. working on
single tokens only), if a length of 0 is requested, then a random
length is chosen.
Also, if a mutation is suggested but would result in an invalid
sequence, then the mutation will not be carried out.
If a mutation is attempted which could corrupt your gene (copying
from a region beyond the end of the gene for instance) then it
will be silently skipped. Mutation methods all return the number
of mutations carried out (not the number of tokens affected).
These methods all expect to be passed positive integers, undef or zero,
other values could (and likely will) do something unpredictable.
AI/Gene/Sequence.pm view on Meta::CPAN
overriding any you do not like in the module.
=item C<mutate_insert([num, pos])>
Inserts a single token into the string at position I<pos>.
The token will be randomly generated by the calling object's
C<generate_token> method.
=item C<mutate_overwrite([num, pos1, pos2, len])>
Copies a section of the gene (starting at I<pos1>, length I<len>)
and writes it back into the gene, overwriting current elements,
starting at I<pos2>.
=item C<mutate_reverse([num, pos, len])>
Takes a sequence within the gene and reverses the ordering of the
elements within that sequence. Starts at position I<pos> for
length I<len>.
=item C<mutate_shuffle([num, pos1, pos2, len])>
This takes a sequence (starting at I<pos1> length I<len>)
from within a gene and moves
it to another position (starting at I<pos2>). Odd things might occur if the
position to move the sequence into lies within the
section to be moved, but the module will try its hardest
to cause a mutation.
=item C<mutate_duplicate([num, pos1, pos2, length])>
This copies a portion of the gene starting at I<pos1> of length
I<length> and then splices it into the gene before I<pos2>.
=item C<mutate_remove([num, pos, length]))>
Deletes I<length> tokens from the gene, starting at I<pos>. Repeats
I<num> times.
=item C<mutate_minor([num, pos])>
This will mutate a single token at position I<pos> in the gene
into one of the same type (as decided by the object's C<generate_token>
method).
=item C<mutate_major([num, pos])>
This changes a single token into a token of any token type.
Token at postition I<pos>. The token is produced by the object's
C<generate_token> method.
=item C<mutate_switch([num, pos1, pos2, len1, len2])>
This takes two sequences within the gene and swaps them
into each other's position. The first starts at I<pos1>
with length I<len1> and the second at I<pos2> with length
I<len2>. If the two sequences overlap, then no mutation will
be attempted.
=back
The following methods are also provided, but you will probably
want to overide them for your own genetic sequences.
=over 4
AI/Gene/Simple.pm view on Meta::CPAN
splice @{$self->[0]}, $pos, 0, $token;
$rt++;
}
return $rt;
}
##
# removes element(s) from sequence
# 0: number of times to perform
# 1: position to affect (undef for rand)
# 2: length to affect, undef => 1, 0 => random length
sub mutate_remove {
my $self = shift;
my $num = +$_[0] || 1;
my $rt = 0;
for (1..$num) {
my $glen = scalar @{$self->[0]};
my $length = !defined($_[2]) ? 1 : ($_[2] || int rand $glen);
return $rt if ($glen - $length) <= 0;
my $pos = defined($_[1]) ? $_[1] : int rand $glen;
next if $pos >= $glen; # outside of gene
splice @{$self->[0]}, $pos, $length;
$rt++;
}
return $rt;
}
##
# copies an element or run of elements into a random place in the gene
# 0: number to perform (or 1)
# 1: posn to copy from (undef for rand)
# 2: posn to splice in (undef for rand)
# 3: length (undef for 1, 0 for random)
sub mutate_duplicate {
my $self = shift;
my $num = +$_[0] || 1;
my $rt = 0;
for (1..$num) {
my $glen = scalar @{$self->[0]};
my $length = !defined($_[3]) ? 1 : ($_[3] || int rand $glen);
my $pos1 = defined($_[1]) ? $_[1] : int rand $glen;
my $pos2 = defined($_[2]) ? $_[2] : int rand $glen;
next if ($pos1 + $length) > $glen;
next if $pos2 > $glen;
splice @{$self->[0]}, $pos2, 0, @{$self->[0]}[$pos1..($pos1+$length-1)];
$rt++;
}
return $rt;
}
##
# Duplicates a sequence and writes it on top of some other position
# 0: num to perform (or 1)
# 1: pos to get from (undef for rand)
# 2: pos to start replacement (undef for rand)
# 3: length to operate on (undef => 1, 0 => rand)
sub mutate_overwrite {
my $self = shift;
my $num = +$_[0] || 1;
my $rt = 0;
for (1..$num) {
my $glen = scalar @{$self->[0]};
my $length = !defined($_[3]) ? 1 : ($_[3] || int rand $glen);
my $pos1 = defined($_[1]) ? $_[1] : int rand $glen;
my $pos2 = defined($_[2]) ? $_[2] : int rand $glen;
next if ( ($pos1 + $length) >= $glen
or $pos2 > $glen);
splice (@{$self->[0]}, $pos2, $length,
@{$self->[0]}[$pos1..($pos1+$length-1)] );
$rt++;
}
return $rt;
}
##
# Takes a run of tokens and reverses their order, is a noop with 1 item
# 0: number to perform
# 1: posn to start from (undef for rand)
# 2: length (undef=>1, 0=>rand)
sub mutate_reverse {
my $self = shift;
my $num = +$_[0] || 1;
my $rt = 0;
for (1..$num) {
my $length = scalar @{$self->[0]};
my $pos = defined($_[1]) ? $_[1] : int rand $length;
my $len = !defined($_[2]) ? 1 : ($_[2] || int rand $length);
next if ($pos >= $length
or $pos + $len > $length);
splice (@{$self->[0]}, $pos, $len,
reverse( @{$self->[0]}[$pos..($pos+$len-1)] ));
$rt++;
}
return $rt;
}
##
# Changes token into one of same type (ie. passes type to generate..)
AI/Gene/Simple.pm view on Meta::CPAN
}
return $rt;
}
##
# swaps over two sequences within the gene
# any sort of oddness can occur if regions overlap
# 0: number to perform
# 1: start of first sequence (undef for rand)
# 2: start of second sequence (undef for rand)
# 3: length of first sequence (undef for 1, 0 for rand)
# 4: length of second sequence (undef for 1, 0 for rand)
sub mutate_switch {
my $self = shift;
my $num = $_[0] || 1;
my $rt = 0;
for (1..$num) {
my $glen = scalar @{$self->[0]};
my $pos1 = defined $_[1] ? $_[1] : int rand $glen;
my $pos2 = defined $_[2] ? $_[2] : int rand length $glen;
next if $pos1 == $pos2;
my $len1 = !defined($_[3]) ? 1 : ($_[3] || int rand $glen);
my $len2 = !defined($_[4]) ? 1 : ($_[4] || int rand $glen);
if ($pos1 > $pos2) { # ensure $pos1 comes first
($pos1, $pos2) = ($pos2, $pos1);
($len1, $len2) = ($len2, $len1);
}
if ( ($pos1 + $len1) > $pos2 # ensure no overlaps
AI/Gene/Simple.pm view on Meta::CPAN
}
return $rt;
}
##
# takes a sequence, removes it, then inserts it at another position
# odd things might occur if posn to replace to lies within area taken from
# 0: number to perform
# 1: posn to get from (undef for rand)
# 2: posn to put (undef for rand)
# 3: length of sequence (undef for 1, 0 for rand)
sub mutate_shuffle {
my $self = shift;
my $num = +$_[0] || 1;
my $rt = 0;
for (1..$num) {
my $glen = scalar @{$self->[0]};
my $pos1 = defined($_[1]) ? $_[1] : int rand $glen;
my $pos2 = defined($_[2]) ? $_[2] : int rand $glen;
AI/Gene/Simple.pm view on Meta::CPAN
=back
The calling conventions for these methods are outlined below.
=head2 Mutation methods
Mutation methods are all named C<mutate_*>. In general, the
first argument will be the number of mutations required, followed
by the positions in the genes which should be affected, followed
by the lengths of sequences within the gene which should be affected.
If positions are not defined, then random ones are chosen. If
lengths are not defined, a length of 1 is assumed (ie. working on
single tokens only), if a length of 0 is requested, then a random
length is chosen.
If a mutation is attempted which could corrupt your gene (copying
from a region beyond the end of the gene for instance) then it
will be silently skipped. Mutation methods all return the number
of mutations carried out (not the number of tokens affected).
=over 4
=item C<mutate([num, ref to hash of probs & methods])>
AI/Gene/Simple.pm view on Meta::CPAN
overriding any you do not like in the module.
=item C<mutate_insert([num, pos])>
Inserts a single token into the string at position I<pos>.
The token will be randomly generated by the calling object's
C<generate_token> method.
=item C<mutate_overwrite([num, pos1, pos2, len])>
Copies a section of the gene (starting at I<pos1>, length I<len>)
and writes it back into the gene, overwriting current elements,
starting at I<pos2>.
=item C<mutate_reverse([num, pos, len])>
Takes a sequence within the gene and reverses the ordering of the
elements within that sequence. Starts at position I<pos> for
length I<len>.
=item C<mutate_shuffle([num, pos1, pos2, len])>
This takes a sequence (starting at I<pos1> length I<len>)
from within a gene and moves
it to another position (starting at I<pos2>). Odd things might occur if the
position to move the sequence into lies within the
section to be moved, but the module will try its hardest
to cause a mutation.
=item C<mutate_duplicate([num, pos1, pos2, length])>
This copies a portion of the gene starting at I<pos1> of length
I<length> and then splices it into the gene before I<pos2>.
=item C<mutate_remove([num, pos, length]))>
Deletes I<length> tokens from the gene, starting at I<pos>. Repeats
I<num> times.
=item C<mutate_minor([num, pos])>
This will mutate a single token at position I<pos> in the gene
into one of the same type (as decided by the object's C<generate_token>
method).
=item C<mutate_major([num, pos])>
This changes a single token into a token of any token type.
Token at postition I<pos>. The token is produced by the object's
C<generate_token> method.
=item C<mutate_switch([num, pos1, pos2, len1, len2])>
This takes two sequences within the gene and swaps them
into each other's position. The first starts at I<pos1>
with length I<len1> and the second at I<pos2> with length
I<len2>. If the two sequences overlap, then no mutation will
be attempted.
=back
The following methods are also provided, but you will probably
want to overide them for your own genetic sequences.
=over 4
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
Added: Extensive test suite (tgene.t)
mutate_overwrite added
BUGFIXES: Most methods have more gene length related sanity checking.
So long as positive integers are used as args, then there should
be no fatal errors through missing the end of substrings.
mutate when called with ref of probs only worked with keys
of generic probs hash, this is now fixed.
0.10 Wed Dec 27 21:00:00 2000
Initial public (but buggy) release.
demo/Musicgene.pm view on Meta::CPAN
@ISA = qw(Exporter AI::Gene::Sequence);
@EXPORT = ();
%EXPORT_TAGS = ();
@EXPORT_OK = qw();
}
our @EXPORT_OK;
our @chords = ([qw(A C G)], [qw(A C E)]); # type c
our @octaves = (3..10); # type o
our @notes = ('A'..'G', 'rest'); # type n
our @lengths = (qw(hn qn), ''); # type l
sub new {
my $class = shift;
my $self = ['',[]];
bless $self, ref($class) || $class;
$self->mutate_insert($_[0]) if $_[0];
return $self;
}
sub generate_token {
demo/Musicgene.pm view on Meta::CPAN
if ($rand < .7) {$type = 'n'}
elsif ($rand < .8) {$type = 'l'}
elsif ($rand < .9) {$type = 'o'}
elsif ($rand < 1 ) {$type = 'c'}
else {die "$0: bad probability: $rand"}
}
$rt[0] = $type;
SWITCH: for ($type) {
/n/ && do {$rt[1] = $notes[rand@notes]; last SWITCH};
/c/ && do {$rt[1] = $chords[rand@chords]; last SWITCH};
/l/ && do {$rt[1] = $lengths[rand@lengths]; last SWITCH};
/o/ && do {$rt[1] = $octaves[rand@octaves]; last SWITCH};
die "$0: unknown type: $type";
}
return @rt[0,1];
}
sub valid_gene {length($_[1]) < 50 ? 1 : 0};
sub write_file {
my $self = shift;
my $file_name = $_[0] or die "$0: No file passed to write_file";
my $opus = MIDI::Simple->new_score();
my $note_length = '';
foreach my $pos (0..(length $self->[0])) {
SWITCH: for (substr($self->[0], $pos, 1)) {
/l/ && do {$note_length = $self->[1][$pos] ;last SWITCH};
/n/ && do {$opus->n($note_length, $self->[1][$pos]) ;last SWITCH};
/o/ && do {$opus->noop('o'.$self->[1][$pos]) ;last SWITCH};
/c/ && do {$opus->n($note_length, @{$self->[1][$pos]}) ;last SWITCH};
}
}
$opus->write_score($file_name);
return;
}
## Also override mutation method
# calls mutation method at random
# 0: number of mutations to perform
demo/Musicgene.pm view on Meta::CPAN
else { # use standard mutations and probs
foreach (1..$num_mutates) {
my $rand = rand;
if ($rand < $probs{insert}) {
$rt += $self->mutate_insert(1);
}
elsif ($rand < $probs{remove}) {
$rt += $self->mutate_remove(1);
}
elsif ($rand < $probs{duplicate}) {
$rt += $self->mutate_duplicate(1,undef, undef,0); # random length
}
elsif ($rand < $probs{minor}) {
$rt += $self->mutate_minor(1);
}
elsif ($rand < $probs{major}) {
$rt += $self->mutate_major(1);
}
elsif ($rand < $probs{overwrite}) {
$rt += $self->mutate_overwrite(1,undef,undef,0);
}
demo/Regexgene.pm view on Meta::CPAN
from the start.
As can be seen, we use array offsets above $self->[1] to store information
which is specific to our implementation.
=cut
sub new {
my $gene = ['',[], ref($_[0]) ? $_[0]->[2]-1 : 3 ]; # limit recursion
bless $gene, ref($_[0]) || $_[0];
my $length = $_[1] || 5;
for (1..$length) {
my @token = $gene->generate_token();
my $new = $gene->[0] . $token[0];
redo unless $gene->valid_gene($new); # hmmmm, enter turing from the wings
$gene->[0] = $new;
push @{$gene->[1]}, $token[1];
}
return $gene;
}
=head2 clone
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');
$gene = $main->clone;
$rt = $gene->mutate_overwrite(1,3,4,3); # overlap
ok($rt,1);
ok($gene->g, 'abcddefhij');
ok($gene->d, 'abcddefhij');
$gene = $main->clone;
$rt = $gene->mutate_overwrite(1,0,10,3); # dump lies at end of gene
{ 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
ok($rt,1);
ok($gene->g, 'fghicdeabj');
$gene = $main->clone;
$rt = $gene->mutate_switch(1,0,10); # pos2 outside gene
ok($rt,0);
ok($gene->g, 'abcdefghij');
$gene = $main->clone;
$rt = $gene->mutate_switch(1,10,0); # pos1 outside gene (silently same as)
ok($rt,0);
ok($gene->g, 'abcdefghij');
}
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
ok($rt,1);
ok($gene->d, 'abcddefhij');
$gene = $main->clone;
$rt = $gene->mutate_overwrite(1,0,10,3); # dump lies at end of gene
ok($rt,1);
ok($gene->d, 'abcdefghijabc');
{ 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
ok($rt,1);
ok($gene->d, 'fghicdeabj');
$gene = $main->clone;
$rt = $gene->mutate_switch(1,0,10); # pos2 outside gene
ok($rt,0);
ok($gene->d, 'abcdefghij');
$gene = $main->clone;
$rt = $gene->mutate_switch(1,10,0); # pos1 outside gene (silently same as)
ok($rt,0);
ok($gene->d, 'abcdefghij');
( run in 0.340 second using v1.01-cache-2.11-cpan-55f5a4728d2 )