AI-Gene-Sequence
view release on metacpan or search on metacpan
AI/Gene/Sequence.pm view on Meta::CPAN
$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);
AI/Gene/Sequence.pm view on Meta::CPAN
}
return $rt;
}
# These are intended to be overriden, simple versions are
# provided for the sake of testing.
# Generates things to make up genes
# can be called with a token type to produce, or with none.
# if called with a token type, it will also be passed the original
# token as the second argument.
# should return a two element list of the token type followed by the token itself.
sub generate_token {
my $self = shift;
my $token_type = $_[0];
my $letter = ('a'..'z')[rand 25];
unless ($token_type) {
return ($letter) x2;
}
return ($token_type) x2;
}
# takes sting of token types to be checked for validity.
# If a mutation affects only one place, then the position of the
# mutation can be passed as a second argument.
sub valid_gene {1}
## You might also want to have methods like the following,
# they will not be called by the 'sequence' methods.
# Default constructor
sub new {
my $gene = ['',[]];
return bless $gene, ref $_[0] || $_[0];
}
AI/Gene/Sequence.pm view on Meta::CPAN
These methods all expect to be passed positive integers, undef or zero,
other values could (and likely will) do something unpredictable.
=over 4
=item C<mutate([num, ref to hash of probs & methods])>
This will call at random one of the other mutation methods.
It will repeat itself I<num> times. If passed a reference
to a hash as its second argument, it will use that to
decide which mutation to attempt.
This hash should contain keys which fit $1 in C<mutate_(.*)>
and values indicating the weight to be given to that method.
The module will normalise this nicely, so you do not have to.
This lets you define your own mutation methods in addition to
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
AI/Gene/Sequence.pm view on Meta::CPAN
=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
$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 $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;
AI/Gene/Simple.pm view on Meta::CPAN
}
return $rt;
}
# These are intended to be overriden, simple versions are
# provided for the sake of testing.
# Generates things to make up genes
# can be called with a token type to produce, or with none.
# if called with a token type, it will also be passed the original
# token as the second argument.
# should return a two element list of the token type followed by the token itself.
sub generate_token {
my $self = shift;
my $token_type = $_[0];
my $letter = ('a'..'z')[rand 25];
unless ($token_type) {
return $letter;
}
return $token_type;
AI/Gene/Simple.pm view on Meta::CPAN
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])>
This will call at random one of the other mutation methods.
It will repeat itself I<num> times. If passed a reference
to a hash as its second argument, it will use that to
decide which mutation to attempt.
This hash should contain keys which fit $1 in C<mutate_(.*)>
and values indicating the weight to be given to that method.
The module will normalise this nicely, so you do not have to.
This lets you define your own mutation methods in addition to
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
AI/Gene/Simple.pm view on Meta::CPAN
=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
demo/Regexgene.pm view on Meta::CPAN
=head2 generate_token
This is where we really start needing to have our own implementation.
This method is used by AI::Gene::Sequence when it needs a new
token, we also use it ourselves when we create a new object, but we
did not have to.
If we are provided with a token type, we use that, otherwise we chose
one at random. We make sure that we return a two element list.
If we had wanted, when passed a type of 'g' along with a second
argument, we could have caused this method to mutate the nested
regex, instead, we just create a different one.
=cut
sub generate_token {
my $self = shift;
my $type = $_[0] || (qw(m t c r a g))[rand 6];
my @rt;
$rt[0] = $type;
use strict;
use warnings;
# Gtest is a small package used to test the AI::Gene::Sequence
# package. It provides a generate_token method and a seed_gene
# method, the first is highly deterministic (so tests of a module
# which hinge on randomness can work) and the second sets up a gene
# ready for a test.
# Also is a new method, which creates the gene and seeds it and
# 'd' and 'g' methods, which return (stringified) versions of the
# sequence ($self->[0]) and gene (@{$self->[1]}) respectively.
package GTest;
our (@ISA);
use AI::Gene::Sequence;
@ISA = qw(AI::Gene::Sequence);
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');
$gene = $main->clone;
$rt = $gene->mutate_overwrite(1,3,4,3); # overlap
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');
$gene = $main->clone;
$rt = $gene->mutate_switch(1,0,9,1,2); # second section extends beyond
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);
use strict;
use warnings;
# GtestS is a small package used to test the AI::Gene::Simple
# package. It provides a generate_token method and a seed_gene
# method, the first is highly deterministic (so tests of a module
# which hinge on randomness can work) and the second sets up a gene
# ready for a test.
# Also is a new method, which creates the gene and seeds it and
# a 'd' method, which returns a stringified version of $self->[0]
package GTestS;
our (@ISA);
use AI::Gene::Simple;
@ISA = qw(AI::Gene::Simple);
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
ok($rt,1);
ok($gene->d, 'abcddefhij');
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');
$gene = $main->clone;
$rt = $gene->mutate_switch(1,0,9,1,2); # second section extends beyond
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);
( run in 0.994 second using v1.01-cache-2.11-cpan-39bf76dae61 )