1use strict;
2use warnings;
3
4=head1 NAME
5
6Algorithm::Evolutionary::Op::Uniform_Crossover - interchanges a set of atoms
7  from one parent to the other.
8
9=head1 SYNOPSIS
10
11  #Create from XML description using EvoSpec
12  my $xmlStr3=<<EOC;
13  <op name='Uniform_Crossover' type='binary' rate='1'>
14    <param name='numPoints' value='3' /> #Max is 2, anyways
15  </op>
16  EOC
17  my $op3 = Algorithm::Evolutionary::Op::Base->fromXML( $xmlStr3 );
18  print $op3->asXML(), "\n";
19
20  #Apply to 2 Individuals of the String class
21  my $indi = new Algorithm::Evolutionary::Individual::BitString 10;
22  my $indi2 = $indi->clone();
23  my $indi3 = $indi->clone();
24  my $offspring = $op3->apply( $indi2, $indi3 ); #$indi2 == $offspring
25
26  #Initialize using OO interface
27  my $op4 = new Algorithm::Evolutionary::Op::Uniform_Crossover 0.5;# Crossover rate
28
29=head1 Base Class
30
31L<Algorithm::Evolutionary::Op::Base|Algorithm::Evolutionary::Op::Base>
32
33=head1 DESCRIPTION
34
35General purpose uniform crossover operator
36
37=head1 METHODS
38
39=cut
40
41package Algorithm::Evolutionary::Op::Uniform_Crossover;
42
43use lib qw(../../..);
44
45our ($VERSION) = ( '$Revision: 3.2 $ ' =~ /(\d+\.\d+)/ );
46
47use Clone qw(clone);
48use Carp;
49
50use base 'Algorithm::Evolutionary::Op::Base';
51
52#Class-wide constants
53our $APPLIESTO =  'Algorithm::Evolutionary::Individual::String';
54our $ARITY = 2;
55our %parameters = ( crossover_rate => 2 );
56
57=head2 new( [$options_hash] [, $operation_priority] )
58
59Creates a new n-point crossover operator, with 2 as the default number
60of points, that is, the default would be
61    my $options_hash = { crossover_rate => 0.5 };
62    my $priority = 1;
63
64=cut
65
66sub new {
67  my $class = shift;
68  my $hash = { crossover_rate => shift || 0.5 };
69  croak "Crossover probability must be less than 1"
70    if $hash->{'crossover_rate'} >= 1;
71  my $priority = shift || 1;
72  my $self = Algorithm::Evolutionary::Op::Base::new( $class, $priority, $hash );
73  return $self;
74}
75
76=head2 apply( $chromsosome_1, $chromosome_2 )
77
78Applies xover operator to a "Chromosome", a string, really. Can be
79applied only to I<victims> with the C<_str> instance variable; but
80it checks before application that both operands are of type
81L<String|Algorithm::Evolutionary::Individual::String>.
82
83Changes the first parent, and returns it. If you want to change both
84parents at the same time, check
85L<QuadXOver|Algorithm::Evolutionary::Op::QuadXOver>
86
87=cut
88
89sub  apply ($$$){
90  my $self = shift;
91  my $arg = shift || croak "No victim here!";
92  my $victim = clone( $arg );
93  my $victim2 = shift || croak "No victim here!";
94  my $min_length = (  $victim->size() >  $victim2->size() )?
95      $victim2->size():$victim->size();
96  for ( my $i = 0; $i < $min_length; $i++ ) {
97      if ( rand() < $self->{'_crossover_rate'}) {
98	  $victim->Atom($i, $victim2->Atom($i));
99      }
100  }
101  $victim->{'_fitness'} = undef;
102  return $victim;
103}
104
105=head1 Copyright
106
107  This file is released under the GPL. See the LICENSE file included in this distribution,
108  or go to http://www.fsf.org/licenses/gpl.txt
109
110  CVS Info: $Date: 2011/02/14 06:55:36 $
111  $Header: /media/Backup/Repos/opeal/opeal/Algorithm-Evolutionary/lib/Algorithm/Evolutionary/Op/Uniform_Crossover.pm,v 3.2 2011/02/14 06:55:36 jmerelo Exp $
112  $Author: jmerelo $
113  $Revision: 3.2 $
114  $Name $
115
116=cut
117