File Coverage

lib/Algorithm/Evolutionary/Op/Crossover.pm

Criterion	Covered	Total	%
statement	18	18	100.0
branch			n/a
condition			n/a
subroutine	6	6	100.0
pod			n/a
total	24	24	100.0

use strict;
use warnings;

=head1 NAME

Algorithm::Evolutionary::Op::Crossover - n-point crossover
    operator; puts fragments of the second operand into the first operand


=head1 SYNOPSIS

  #Create from XML description using EvoSpec
  my $xmlStr3=<

     #Max is 2, anyways

  EOC
  my $op3 = Algorithm::Evolutionary::Op::Base->fromXML( $xmlStr3 );
  print $op3->asXML(), "\n";

  #Apply to 2 Individuals of the String class
  my $indi = new Algorithm::Evolutionary::Individual::BitString 10;
  my $offspring = $op3->apply( $indi2, $indi3 ); #$indi2 == $offspring

  #Initialize using OO interface
  my $op4 = new Algorithm::Evolutionary::Op::Crossover 2; #Crossover with 2 crossover points

=head1 Base Class

L

=head1 DESCRIPTION

Crossover operator for a Individuals of type
L and
their descendants
(L). Crossover
for L
would be  L

=head1 METHODS

=cut

package Algorithm::Evolutionary::Op::Crossover;

use lib qw(../../..);

our $VERSION =   sprintf "%d.%03d", q$Revision: 3.2 $ =~ /(\d+)\.(\d+)/g; # Hack for avoiding version mismatch

use Clone qw(clone);
use Carp;

use base 'Algorithm::Evolutionary::Op::Base';

#Class-wide constants
our $APPLIESTO =  'Algorithm::Evolutionary::Individual::String';
our $ARITY = 2;
our %parameters = ( numPoints => 2 );

=head2 new( [$options_hash] [, $operation_priority] )

Creates a new n-point crossover operator, with 2 as the default number
of points, that is, the default would be
    my $options_hash = { numPoints => 2 };
    my $priority = 1;

=cut

sub new {
  my $class = shift;
  my $hash = { numPoints => shift || 2 };
  my $rate = shift || 1;
  my $self = Algorithm::Evolutionary::Op::Base::new( $class, $rate, $hash );
  return $self;
}

=head2 apply( $chromsosome_1, $chromosome_2 )

Applies xover operator to a "Chromosome", a string, really. Can be
applied only to I with the C<_str> instance variable; but
it checks before application that both operands are of type
L.

Changes the first parent, and returns it. If you want to change both
parents at the same time, check L

=cut

sub  apply ($$$){
  my $self = shift;
  my $arg = shift || croak "No victim here!";
  my $victim = clone( $arg );
  my $victim2 = shift || croak "No victim here!";
  my $minlen = (  length( $victim->{_str} ) >  length( $victim2->{_str} ) )?
	 length( $victim2->{_str} ): length( $victim->{_str} );
  my $pt1 = int( rand( $minlen ) );
  my $range = 1 + int( rand( $minlen  - $pt1 ) );
#  print "Puntos: $pt1, $range \n";
  croak "No number of points to cross defined" if !defined $self->{_numPoints};
  if ( $self->{_numPoints} > 1 ) {
	$range =  int ( rand( length( $victim->{_str} ) - $pt1 ) );
  }

  substr( $victim->{_str}, $pt1, $range ) = substr( $victim2->{_str}, $pt1, $range );
  $victim->{'_fitness'} = undef;
  return $victim;
}

=head1 SEE ALSO

=over 4

=item L for pass-by-reference xover

=item L another more mutation-like xover

=item L don't disturb the building blocks!

=item L vive la difference!

=back

=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: 2011/02/14 06:55:36 $
  $Header: /media/Backup/Repos/opeal/opeal/Algorithm-Evolutionary/lib/Algorithm/Evolutionary/Op/Crossover.pm,v 3.2 2011/02/14 06:55:36 jmerelo Exp $
  $Author: jmerelo $
  $Revision: 3.2 $
  $Name $

=cut