1use strict; 2use warnings; 3 4=head1 NAME 5 6Algorithm::Evolutionary::Op::Gene_Boundary_Crossover - n-point crossover 7 operator that restricts crossing point to gene boundaries 8 9 10=head1 SYNOPSIS 11 12 #Create from XML description using EvoSpec 13 my $xmlStr3=<<EOC; 14 <op name='Gene_Boundary_Crossover' type='binary' rate='1'> 15 <param name='numPoints' value='3' /> #Max is 2, anyways 16 </op> 17 EOC 18 my $op3 = Algorithm::Evolutionary::Op::Base->fromXML( $xmlStr3 ); 19 print $op3->asXML(), "\n"; 20 21 #Apply to 2 Individuals of the String class 22 my $indi = new Algorithm::Evolutionary::Individual::BitString 10; 23 my $indi2 = $indi->clone(); 24 my $indi3 = $indi->clone(); 25 my $offspring = $op3->apply( $indi2, $indi3 ); #$indi2 == $offspring 26 27 #Initialize using OO interface 28 my $op4 = new Algorithm::Evolutionary::Op::Gene_Boundary_Crossover 3; #Gene_Boundary_Crossover with 3 crossover points 29 30=head1 Base Class 31 32L<Algorithm::Evolutionary::Op::Base|Algorithm::Evolutionary::Op::Base> 33 34=head1 DESCRIPTION 35 36Crossover operator for a Individuals of type 37L<Algorithm::Evolutionary::Individual::String|Individual::String> and 38their descendants 39(L<Algorithm::Evolutionary::Individual::BitString|Individual::BitString>). Crossover 40for L<Algorithm::Evolutionary::Individual::Vector|Individual::Vector> 41would be L<Algorithm::Evolutionary::Op::VectorCrossover|Op::VectorCrossover> 42 43 44=head1 METHODS 45 46=cut 47 48package Algorithm::Evolutionary::Op::Gene_Boundary_Crossover; 49 50use lib qw(../../..); 51 52our $VERSION = sprintf "%d.%03d", q$Revision: 3.2 $ =~ /(\d+)\.(\d+)/g; # Hack for avoiding version mismatch 53 54use Clone qw(clone); 55use Carp; 56 57use base 'Algorithm::Evolutionary::Op::Base'; 58 59#Class-wide constants 60our $APPLIESTO = 'Algorithm::Evolutionary::Individual::String'; 61our $ARITY = 2; 62 63=head2 new( [$options_hash] [, $operation_priority] ) 64 65Creates a new n-point crossover operator, with 2 as the default number 66of points, that is, the default would be 67 my $options_hash = { numPoints => 2 }; 68 my $priority = 1; 69 70=cut 71 72sub new { 73 my $class = shift; 74 my $num_points = shift || 2; 75 my $gene_size = shift || croak "No default gene size"; 76 my $hash = { numPoints => $num_points, gene_size => $gene_size }; 77 my $rate = shift || 1; 78 my $self = Algorithm::Evolutionary::Op::Base::new( __PACKAGE__, $rate, $hash ); 79 return $self; 80} 81 82=head2 create( [$num_points] ) 83 84Creates a new 1 or 2 point crossover operator. But this is just to have a non-empty chromosome 85Defaults to 2 point 86 87=cut 88 89sub create { 90 my $class = shift; 91 my $self; 92 $self->{_numPoints} = shift || 2; 93 $self->{_gene_size} = shift || croak "No default for gene size\n"; 94 bless $self, $class; 95 return $self; 96} 97 98=head2 apply( $chromsosome_1, $chromosome_2 ) 99 100Applies xover operator to a "Chromosome", a string, really. Can be 101applied only to I<victims> with the C<_str> instance variable; but 102it checks before application that both operands are of type 103L<BitString|Algorithm::Evolutionary::Individual::String>. 104 105=cut 106 107sub apply ($$$){ 108 my $self = shift; 109 my $arg = shift || croak "No victim here!"; 110# my $victim = $arg->clone(); 111 my $gene_size = $self->{'_gene_size'}; 112 my $victim = clone( $arg ); 113 my $victim2 = shift || croak "No victim here!"; 114# croak "Incorrect type ".(ref $victim) if !$self->check($victim); 115# croak "Incorrect type ".(ref $victim2) if !$self->check($victim2); 116 my $minlen = ( length( $victim->{_str} ) > length( $victim2->{_str} ) )? 117 length( $victim2->{_str} )/$gene_size: length( $victim->{_str} )/$gene_size; 118 croak "Crossover not possible" if ($minlen == 1); 119 my ($pt1, $range ); 120 if ( $minlen == 2 ) { 121 $pt1 = $range = 1; 122 } else { 123 $pt1 = int( rand( $minlen - 1 ) ); 124# print "Puntos: $pt1, $range \n"; 125 croak "No number of points to cross defined" if !defined $self->{_numPoints}; 126 if ( $self->{_numPoints} > 1 ) { 127 $range = int ( 1 + rand( length( $victim->{_str} )/$gene_size - $pt1 - 1) ); 128 } else { 129 $range = 1 + int( $minlen - $pt1 ); 130 } 131 } 132 133 substr( $victim->{_str}, $pt1*$gene_size, $range*$gene_size ) 134 = substr( $victim2->{_str}, $pt1*$gene_size, $range*$gene_size ); 135 $victim->{'_fitness'} = undef; 136 return $victim; 137} 138 139=head1 Copyright 140 141 This file is released under the GPL. See the LICENSE file included in this distribution, 142 or go to http://www.fsf.org/licenses/gpl.txt 143 144 CVS Info: $Date: 2011/02/14 06:55:36 $ 145 $Header: /media/Backup/Repos/opeal/opeal/Algorithm-Evolutionary/lib/Algorithm/Evolutionary/Op/Gene_Boundary_Crossover.pm,v 3.2 2011/02/14 06:55:36 jmerelo Exp $ 146 $Author: jmerelo $ 147 $Revision: 3.2 $ 148 $Name $ 149 150=cut 151