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