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