use strict; use warnings; =head1 NAME Algorithm::Evolutionary::Op::ChangeLengthMutation - Increases/decreases by one the length of the string =head1 SYNOPSIS my $xmlStr2=< EOC my $ref2 = XMLin($xmlStr2); my $op2 = Algorithm::Evolutionary::Op::Base->fromXML( $ref2 ); print $op2->asXML(), "\n*Arity ", $op->arity(), "\n"; my $op = new Algorithm::Evolutionary::Op::ChangeLengthMutation 1, 0.5, 0.5; #Create from scratch =head1 Base Class L =head1 DESCRIPTION Increases or decreases the length of a string, by adding a random element, or eliminating it. =head1 METHODS =cut package Algorithm::Evolutionary::Op::ChangeLengthMutation; our ($VERSION) = ( '$Revision: 1.3 $ ' =~ /(\d+\.\d+)/ ); use Carp; use Algorithm::Evolutionary::Op::Base; our @ISA = qw(Algorithm::Evolutionary::Op::Base); #Class-wide constants our $APPLIESTO = 'Algorithm::Evolutionary::Individual::String'; our $ARITY = 1; =head2 new Creates a new operator. It is called with 3 arguments: the rate it's going to be applied, and the probability of adding and substracting an element from the string each time it's applied. Rates default to one. =cut sub new { my $class = shift; my $rate = shift; my $probplus = shift || 1; my $probminus = shift || 1; my $self = { rate => $rate, _probplus => $probplus, _probminus => $probminus }; bless $self, $class; return $self; } =head2 create Creates a new operator. It is called with 3 arguments: the rate it's going to be applied, and the probability of adding and substracting an element from the string each time it's applied. Rates default to one. =cut sub create { my $class = shift; my $rate = shift; my $probplus = shift || 1; my $probminus = shift || 1; my $self = { _rate => $rate, _probplus => $probplus, _probminus => $probminus }; bless $self, $class; return $self; } =head2 apply This is the function that does the stuff. The probability of adding and subsctracting are normalized. Depending on a random draw, a random char is added to the string (at the end) or eliminated from a random position within the string. =cut sub apply ($$){ my $self = shift; my $arg = shift || croak "No victim here!"; my $victim = $arg->clone(); croak "Incorrect type ".(ref $victim) if ! $self->check( $victim ); #Select increment or decrement my $total = $self->{_probplus} + $self->{_probminus}; my $rnd = rand( $total ); if ( $rnd < $self->{_probplus} ) { #Incrementar my $idx = rand( @{$victim->{_chars}} ); my $char = $victim->{_chars}[$idx]; $victim->addAtom( $char ); } else { my $idx = rand( length($victim->{_str}) ); substr( $victim->{_str}, $idx, 1 ) =''; } $victim->Fitness(undef); return $victim; } =head1 Copyright This file is released under the GPL. See the LICENSE file included in this distribution, or go to http://www.fsf.org/licenses/gpl.txt CVS Info: $Date: 2002/06/20 15:41:35 $ $Header: /cvsroot/opeal/opeal/Algorithm/Evolutionary/Op/ChangeLengthMutation.pm,v 1.3 2002/06/20 15:41:35 jmerelo Exp $ $Author: jmerelo $ $Revision: 1.3 $ $Name $ =cut