1use strict;
2use warnings;
3
4=head1 NAME
5
6  Algorithm::Evolutionary::Op::StringRand - randomly change chars in a string
7
8=cut
9
10=head1 SYNOPSIS
11
12  my $xmlStr2=<<EOC;
13    <op name='StringRand' type='unary' rate='0.5' />
14      <param name='numchars' value='1' />
15    </op>
16  EOC
17  my $ref2 = XMLin($xmlStr2);
18
19  my $op2 = Algorithm::Evolutionary::Op::Base->fromXML( $ref2 );
20  print $op2->asXML(), "\n*Arity ", $op->arity(), "\n";
21
22  my $op = new Algorithm::Evolutionary::Op::StringRand 3; #Change 3 characters
23
24=head1 Base Class
25
26L<Algorithm::Evolutionary::Op::Base|Algorithm::Evolutionary::Op::Base>
27
28
29=head1 DESCRIPTION
30
31  Mutation operator for a GA; changes a single element in a string by
32  changing it to the next in the sequence deducted from the chromosome
33  itself.
34
35=cut
36
37package Algorithm::Evolutionary::Op::StringRand;
38
39our $VERSION =   sprintf "%d.%03d", q$Revision: 3.1 $ =~ /(\d+)\.(\d+)/g;
40
41use Carp;
42
43use base 'Algorithm::Evolutionary::Op::Base';
44
45#Class-wide constants
46our $APPLIESTO =  'Algorithm::Evolutionary::Individual::String';
47our $ARITY = 1;
48
49=head2 create()
50
51Creates a new mutation operator.
52
53=cut
54
55sub create {
56  my $class = shift;
57  my $self = {};
58  bless $self, $class;
59  return $self;
60}
61
62=head2 apply( $victim )
63
64Applies mutation operator to a "Chromosome", a string, really. Can be
65applied only to I<victims> with the C<_str> instance variable; but
66it checks before application that both operands are of the required
67type. The chosen character is changed to the next or previous in
68the array of chars used for coding the the string
69    my $strChrom = new Algorithm::Evolutionary::Individual::String ['a','c','g','t'] 10;
70    my $xmen = new Algorithm::Evolutionary::Op::IncMutation;
71    $xmen->apply( $strChrom ) # will change 'acgt' into 'aagt' or
72			      # 'aggt', for instance
73
74=cut
75
76sub apply ($;$){
77  my $self = shift;
78  my $arg = shift || croak "No victim here!";
79  my $victim = $arg->clone();
80  croak "Incorrect type ".(ref $victim) if ! $self->check( $victim );
81  my $rnd = int (rand( length( $victim->{_str} ) ));
82  my $char = $victim->Atom( $rnd );
83  #Compute its place in the array
84  my $i = 0;
85  #Compute order in the array
86  while (  ($victim->{_chars}[$i] ne $char )
87		   && ($i < @{$victim->{_chars}}) ) { $i++;};
88  #Generate next or previous
89  my $newpos = ( rand() > 0.5)?$i-1:$i+1;
90  $newpos = @{$victim->{_chars}}-1 if !$newpos;
91  $newpos = 0 if $newpos >= @{$victim->{_chars}};
92  substr( $victim->{_str}, $rnd, 1 ) =  $victim->{_chars}[$newpos];
93  $victim->Fitness(undef);
94  return $victim;
95}
96
97=head1 Copyright
98
99  This file is released under the GPL. See the LICENSE file included in this distribution,
100  or go to http://www.fsf.org/licenses/gpl.txt
101
102  CVS Info: $Date: 2009/11/17 19:19:41 $
103  $Header: /media/Backup/Repos/opeal/opeal/Algorithm-Evolutionary/lib/Algorithm/Evolutionary/Op/StringRand.pm,v 3.1 2009/11/17 19:19:41 jmerelo Exp $
104  $Author: jmerelo $
105  $Revision: 3.1 $
106  $Name $
107
108=cut
109
110