AI-Gene-Sequence

 view release on metacpan or  search on metacpan

AI/Gene/Sequence.pm  view on Meta::CPAN

# 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];
}

# remember that clone method may require deep copying depending on
# your specific needs

sub clone {
  my $self = shift;
  my $new = [$self->[0]];
  $new->[1] = [@{$self->[1]}];
  return bless $new, ref $self;
}

# You need some way to use the gene you've made and mutated, but
# this will let you have a look, if it starts being odd.

sub render_gene {
  my $self = shift;
  my $return =  "$self\n";
  $return .= $self->[0] . "\n";
  $return .= (join ',', @{$self->[1]}). "\n";

AI/Gene/Simple.pm  view on Meta::CPAN

  }
  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];
}

# remember that clone method may require deep copying depending on
# your specific needs

sub clone {
  my $self = shift;
  my $new = [];
  $new->[0] = [@{$self->[0]}];
  return bless $new, ref $self;
}

# You need some way to use the gene you've made and mutated, but
# this will let you have a look, if it starts being odd.

sub render_gene {
  my $self = shift;
  my $return =  "$self\n";
  $return .= (join ',', @{$self->[0]}). "\n";
  return $return;

demo/Musicgene.pm  view on Meta::CPAN

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;

demo/Regexgene.pm  view on Meta::CPAN

expression and uses the B<valid_gene> method to ensure we stay sane 
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;
}

demo/Regexgene.pm  view on Meta::CPAN

=head2 clone

As we are going to allow nested sequences, then we need to make sure that
when we copy an object we create new versions of everthing, rather than
reusing pointers to data used by other objects.

=cut

sub clone {
  my $self = shift;
  my $new = bless [$self->[0], [], $self->[2]], ref($self);
  @{$new->[1]} = map {ref($_) ? $_->clone : $_} @{$self->[1]}; # woohoo, recursive objects
  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.

t/tgene.t  view on Meta::CPAN

# sequence ($self->[0]) and gene (@{$self->[1]}) respectively.

package GTest;
our (@ISA);
use AI::Gene::Sequence;
@ISA = qw(AI::Gene::Sequence);

sub new {
  my $class = shift;
  my $self = ['',[]];
  bless $self, $class;
  $self->seed_gene;
  return $self;
}

sub seed_gene {
  my $self = shift;
  $self->[0] = join('', 'a'..'j');
  @{$self->[1]} = ('a'..'j');
  return 1;
}

t/tsimp.t  view on Meta::CPAN

# a 'd' method, which returns a stringified version of $self->[0]

package GTestS;
our (@ISA);
use AI::Gene::Simple;
@ISA = qw(AI::Gene::Simple);

sub new {
  my $class = shift;
  my $self = [[]];
  bless $self, $class;
  $self->seed_gene;
  return $self;
}

sub seed_gene {
  my $self = shift;
  @{$self->[0]} = ('a'..'j');
  return 1;
}