1use strict; 2use warnings; 3 4=head1 NAME 5 6Algorithm::Evolutionary::Op::ChangeLengthMutation - Increases/decreases by one atom the length of the string 7 8=head1 SYNOPSIS 9 10 my $xmlStr2=<<EOC; 11 <op name='ChangeLengthMutation' type='unary' rate='0.5' /> 12 EOC 13 my $ref2 = XMLin($xmlStr2); 14 15 my $op2 = Algorithm::Evolutionary::Op::Base->fromXML( $ref2 ); 16 print $op2->asXML(), "\n*Arity ", $op->arity(), "\n"; 17 18 my $op = new Algorithm::Evolutionary::Op::ChangeLengthMutation 1, 0.5, 0.5; #Create from scratch 19 20=head1 Base Class 21 22L<Algorithm::Evolutionary::Op::Base|Algorithm::Evolutionary::Op::Base> 23 24=head1 DESCRIPTION 25 26Increases or decreases the length of a string, by adding a random element, or 27eliminating it. 28 29=head1 METHODS 30 31=cut 32 33package Algorithm::Evolutionary::Op::ChangeLengthMutation; 34 35our ($VERSION) = ( '$Revision: 3.1 $ ' =~ /(\d+\.\d+)/ ); 36 37use Carp; 38 39use base 'Algorithm::Evolutionary::Op::Base'; 40 41#Class-wide constants 42our $APPLIESTO = 'Algorithm::Evolutionary::Individual::String'; 43our $ARITY = 1; 44 45=head2 new( $rate[, $increment_probability] [, $decrement_probability] 46 47Creates a new operator. It is called with 3 arguments: the rate it's 48going to be applied, and the probability of adding and substracting an 49element from the string each time it's applied. 50 51=cut 52 53sub new { 54 my $class = shift; 55 my $rate = shift; 56 my $probplus = shift || 1; 57 my $probminus = shift || 1; 58 my $self = { rate => $rate, 59 _probplus => $probplus, 60 _probminus => $probminus }; 61 62 bless $self, $class; 63 return $self; 64} 65 66=head2 create 67 68Creates a new operator. It is called with 3 arguments: the rate it's 69going to be applied, and the probability of adding and substracting an 70element from the string each time it's applied. Rates default to one. 71 72=cut 73 74sub create { 75 my $class = shift; 76 my $rate = shift; 77 my $probplus = shift || 1; 78 my $probminus = shift || 1; 79 my $self = { _rate => $rate, 80 _probplus => $probplus, 81 _probminus => $probminus }; 82 bless $self, $class; 83 return $self; 84} 85 86=head2 apply 87 88This is the function that does the stuff. The probability of adding 89and substracting are normalized. Depending on a random draw, a random 90char is added to the string (at the end) or eliminated from a random 91position within the string.. 92 93=cut 94 95sub apply ($$){ 96 my $self = shift; 97 my $arg = shift || croak "No victim here!"; 98 my $victim = $arg->clone(); 99 croak "Incorrect type ".(ref $victim) if ! $self->check( $victim ); 100 101 #Select increment or decrement 102 my $total = $self->{_probplus} + $self->{_probminus}; 103 my $rnd = rand( $total ); 104 if ( $rnd < $self->{_probplus} ) { #Incrementar 105 my $idx = rand( @{$victim->{_chars}} ); 106 my $char = $victim->{_chars}[$idx]; 107 $victim->addAtom( $char ); 108 } else { 109 my $idx = rand( length($victim->{_str}) ); 110 substr( $victim->{_str}, $idx, 1 ) =''; 111 } 112 $victim->Fitness(undef); 113 return $victim; 114} 115 116=head1 Copyright 117 118 This file is released under the GPL. See the LICENSE file included in this distribution, 119 or go to http://www.fsf.org/licenses/gpl.txt 120 121 CVS Info: $Date: 2009/09/13 12:49:04 $ 122 $Header: /media/Backup/Repos/opeal/opeal/Algorithm-Evolutionary/lib/Algorithm/Evolutionary/Op/ChangeLengthMutation.pm,v 3.1 2009/09/13 12:49:04 jmerelo Exp $ 123 $Author: jmerelo $ 124 $Revision: 3.1 $ 125 $Name $ 126 127=cut 128 129