1use strict; 2use warnings; 3 4=head1 NAME 5 6Algorithm::Evolutionary::Op::QuadXOver - N-point crossover operator that changes operands 7 8 9 10=head1 SYNOPSIS 11 12 my $xmlStr3=<<EOC; 13 <op name='QuadXOver' type='binary' rate='1'> 14 <param name='numPoints' value='2' /> #Max is 2, anyways 15 </op> 16 EOC 17 my $ref3 = XMLin($xmlStr3); 18 19 my $op3 = Algorithm::Evolutionary::Op::Base->fromXML( $ref3 ); 20 print $op3->asXML(), "\n"; 21 22 my $indi = new Algorithm::Evolutionary::Individual::BitString 10; 23 my $indi2 = $indi->clone(); 24 my $indi3 = $indi->clone(); #Operands are modified, so better to clone them 25 $op3->apply( $indi2, $indi3 ); 26 27 my $op4 = new Algorithm::Evolutionary::Op::QuadXOver 1; #QuadXOver with 1 crossover points 28 29=head1 Base Class 30 31L<Algorithm::Evolutionary::Op::Base|Algorithm::Evolutionary::Op::Base> 32 33=head1 DESCRIPTION 34 35Crossover operator for a GA, takes args by reference and issues two 36children from two parents 37 38=head1 METHODS 39 40=cut 41 42package Algorithm::Evolutionary::Op::QuadXOver; 43 44use lib qw( ../../.. ); 45 46our $VERSION = sprintf "%d.1%02d", q$Revision: 3.4 $ =~ /(\d+)\.(\d+)/g; # Hack for avoiding version mismatch 47 48use Carp; 49 50use base 'Algorithm::Evolutionary::Op::Crossover'; 51 52#Class-wide constants 53our $APPLIESTO = 'Algorithm::Evolutionary::Individual::String'; 54our $ARITY = 2; 55 56=head2 apply( $parent_1, $parent_2 ) 57 58Same as L<Algorithm::Evolutionary::Op::Crossover>, but changes 59parents, does not return anything; that is, $parent_1 and $parent_2 60interchange genetic material. 61 62=cut 63 64sub apply ($$){ 65 my $self = shift; 66 my $victim = shift || croak "No victim here!"; 67 my $victim2 = shift || croak "No victim here!"; 68# croak "Incorrect type ".(ref $victim) if !$self->check($victim); 69# croak "Incorrect type ".(ref $victim2) if !$self->check($victim2); 70 my $minlen = ( length( $victim->{_str} ) > length( $victim2->{_str} ) )? 71 length( $victim2->{_str} ): length( $victim->{_str} ); 72 my $pt1 = 1+int( rand( $minlen - 1 ) ); # first crossover point shouldn't be 0 73 my $range; 74 if ( $self->{_numPoints} > 1 ) { 75 $range= 1 + int( rand( $minlen - $pt1 ) ); 76 } else { 77 $range = $minlen - $pt1; 78 } 79# print "Puntos: $pt1, $range \n"; 80 my $str = $victim->{_str}; 81 substr( $victim->{_str}, $pt1, $range ) = substr( $victim2->{_str}, $pt1, $range ); 82 substr( $victim2->{_str}, $pt1, $range ) = substr( $str, $pt1, $range ); 83 $victim->Fitness( undef ); 84 $victim2->Fitness( undef ); 85 return undef; #As a warning that you should not expect anything 86} 87 88=head1 Copyright 89 90 This file is released under the GPL. See the LICENSE file included in this distribution, 91 or go to http://www.fsf.org/licenses/gpl.txt 92 93 CVS Info: $Date: 2010/12/08 17:34:22 $ 94 $Header: /media/Backup/Repos/opeal/opeal/Algorithm-Evolutionary/lib/Algorithm/Evolutionary/Op/QuadXOver.pm,v 3.4 2010/12/08 17:34:22 jmerelo Exp $ 95 $Author: jmerelo $ 96 $Revision: 3.4 $ 97 $Name $ 98 99=cut 100