AI-Gene-Sequence
view release on metacpan or search on metacpan
AI/Gene/Sequence.pm view on Meta::CPAN
next unless $self->valid_gene($new);
$self->[0] = $new;
splice (@{$self->[1]}, $pos, $len,
reverse( @{$self->[1]}[$pos..($pos+$len-1)] ));
$rt++;
}
return $rt;
}
##
# 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);
$self->[0] = $new;
$self->[1][$pos] = $token[1];
}
$rt++;
AI/Gene/Sequence.pm view on Meta::CPAN
}
$rt++;
}
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 = ['',[]];
AI/Gene/Sequence.pm view on Meta::CPAN
package Somegene;
use AI::Gene::Sequence;
our @ISA = qw(AI::Gene::Sequence);
my %things = ( a => [qw(a1 a2 a3 a4 a5)],
b => [qw(b1 b2 b3 b4 b5)],);
sub generate_token {
my $self = shift;
my ($type, $prev) = @_;
if ($type) {
$prev = ${ $things{$type} }[rand @{ $things{$type} }];
}
else {
$type = ('a','b')[rand 2];
$prev = ${$things{$type}}[rand @{$things{$type}}];
}
return ($type, $prev);
}
sub valid_gene {
my $self = shift;
return 0 if $_[0] =~ /(.)\1/;
return 1;
}
sub seed {
my $self = shift;
AI/Gene/Sequence.pm view on Meta::CPAN
which are used to analyse DNA sequences.
It is intended that the methods in this code are inherited
by other modules.
=head2 Anatomy of a gene
A gene is a sequence of tokens, each a member of some group
of simillar tokens (they can of course all be members of a
single group). This module encodes genes as a string
representing token types, and an array containing the
tokens themselves, this allows for arbitary data to be
stored as a token in a gene.
For instance, a regular expression could be encoded as:
$self = ['ccartm',['a', 'b', '|', '[A-Z]', '\W', '*?'] ]
Using a string to indicate the sort of thing held at the
corresponding part of the gene allows for a simple test
of the validity of a proposed gene by using a regular
AI/Gene/Sequence.pm view on Meta::CPAN
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
=item C<generate_token([token type, current token])>
This is used by the mutation methods when changing tokens or
creating new ones. It is expected to return a list consisting
of a single character to indicate the token type being produced
and the token itself. Where it makes sense to do so the token
which is about to be modifed is passed along with the token type.
If the calling methods require a token of any type, then no
arguments will be passed to this method.
The provided version of this method returns a random character
from 'a'..'z' as both the token type and token.
=item C<valid_gene(string [, posn])>
This is used to determine if a proposed mutation is allowed. This
method is passed a string of the whole gene's token types, it will
also be passed a position in the gene where this makes sense (for
instance, if only one token is to change). It is expected to
return a true value if a change is acceptable and a false one
if it is not.
The provided version of this method always returns true.
=item C<clone()>
This returns a copy of the gene as a new object. If you are using
AI/Gene/Simple.pm view on Meta::CPAN
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..)
# 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 $glen = scalar @{$self->[0]};
my $pos = defined $_[1] ? $_[1] : int rand $glen;
next if $pos >= $glen; # pos lies outside of gene
my $type = $self->[0][$pos];
my $token = $self->generate_token($type);
$self->[0][$pos] = $token;
$rt++;
}
return $rt;
}
##
# Changes one token into some other token
# 0: number to perform
# 1: position to affect (undef for random)
AI/Gene/Simple.pm view on Meta::CPAN
}
$rt++;
}
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;
}
## 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 = [[]]; # leave space for other info
return bless $gene, ref $_[0] || $_[0];
}
AI/Gene/Simple.pm view on Meta::CPAN
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.
AI/Gene/Simple.pm view on Meta::CPAN
=over 4
=item C<generate_token([current token])>
This is used by the mutation methods when changing tokens or
creating new ones. It is expected to return a single token.
If a minor mutation is being attempted, then the method will
also be passed the current token.
The provided version of this method returns a random character
from 'a'..'z' as both the token type and token.
=item C<clone()>
This returns a copy of the gene as a new object. If you are using
nested genes, or other references as your tokens, then you may need
to produce your own version which will deep copy your structure.
=item C<new>
This returns an empty gene, into which you can put things. If you
--- #YAML:1.0
name: AI-Gene-Sequence
version: 0.22
abstract: ~
author: []
license: unknown
distribution_type: module
configure_requires:
ExtUtils::MakeMaker: 0
build_requires:
ExtUtils::MakeMaker: 0
requires: {}
no_index:
directory:
- t
- inc
generated_by: ExtUtils::MakeMaker version 6.55_02
demo/Musicgene.pm view on Meta::CPAN
use AI::Gene::Sequence;
our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
$VERSION = 0.01;
@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 {
my $self = shift;
my ($type, $prev) = @_[0,1];
my @rt;
unless ($type) {
my $rand = rand;
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();
demo/Regexgene.pm view on Meta::CPAN
$VERSION = 0.01;
@ISA = qw(Exporter AI::Gene::Sequence);
@EXPORT = ();
%EXPORT_TAGS = ();
@EXPORT_OK = qw();
}
our @EXPORT_OK;
=head2 Globals
We have a load of globals, these form the basis of our token types, anything
from the same array, is the same type eg.
@modifiers = qw( * *? + +? ?? ); # are of type 'm' for modifier
=cut
our @modifiers = qw( * *? + +? ?? );
our @char_types = qw( \w \W \d \D \s \S .);
our @ranges = qw( [A-Z] [a-z] [0-9] );
our @chars = ((0..9,'a'..'z','A'..'Z','_'),
(map '\\'.chr, 32..47, 58..64, 91..94, 96, 123..126));
=head2 Constructor
As we want to be able to fill our regular expression at the same
time as we create it and because we will want to nest sequences
we will need some way to know how deep we are, then a different
demo/Regexgene.pm view on Meta::CPAN
return $new;
}
=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;
SWITCH: for ($type) {
/^m/ && do {$rt[1] = $modifiers[rand@modifiers] ;last SWITCH}; # modifier
/^t/ && do {$rt[1] = $char_types[rand@char_types];last SWITCH}; # type
/^c/ && do {$rt[1] = $chars[rand@chars] ;last SWITCH}; # lone char
/^r/ && do {$rt[1] = $ranges[rand@ranges] ;last SWITCH}; # range
/^a/ && do {$rt[1] = '|' ;last SWITCH}; # altern
/^g/ && do {
if ($self->[2] > 0) { # recursion avoidance...
$rt[1] = $self->new;
}
else {
$rt[1] = $chars[rand@chars];
}
;last SWITCH}; # grouping
die "Unknown type of regex token ($type)";
}
return @rt[0,1];
}
# returns true if a valid regex, otherwise false, ignores optional posn arg
=head2 valid_gene
Because we have restricted ourselves to simple regular
expressions we only need to make sure that modifers and alternation
sub seed_gene {
my $self = shift;
$self->[0] = join('', 'a'..'j');
@{$self->[1]} = ('a'..'j');
return 1;
}
sub generate_token {
my $self = shift;
my ($type, $prev) = @_;
$type ||= 'n';
$prev = uc $type;
return ($type, $prev);
}
sub d {
my $self = shift;
return $self->[0];
}
sub g {
my $self = shift;
return join('', @{$self->[1]});
( run in 3.159 seconds using v1.01-cache-2.11-cpan-df04353d9ac )