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