view release on metacpan or  search on metacpan

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;
 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
do not follow or precede things they should not.

Note that we do not use the current version of the gene in $self->[0].
This is because it is the un-mutated version, if we do not accept the
mutation then $self will be left alone by our calling methods.

That said, if you want to use $self->[0] then you can, but it would
be unwise to modify it here.

=cut

sub valid_gene {
  my $self = shift;
  my $gene = $_[0];
  if ($gene =~ /mm|am|aa|^a|^m|a$/) {
    return undef;
  }
  else {
    return 1;
  }
}

=head2

Having created a way to create, modify and verify our genetically
encoded regular expressions, we could do with some way to actually
use them.  This method retuns a non compiled regular expression and
calls itself recursively when it finds nested genes.

=cut

sub regex {
  my $self = shift;
  my $rt;
  warn "$0: empty gene turned into empty regex" unless scalar @{$self->[1]};
  foreach (@{$self->[1]}) {
    $rt .= ref($_) ? '(?:'. $_->regex .')' : $_;
  }
  return $rt;
}

=head1 AUTHOR

Alex Gough (F<alex@rcon.org>).

=head1 COPYRIGHT

Copyright (c) 2001 Alex Gough <F<alex@rcon.org>>. All rights reserved.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

=cut

1;
__END__;