1use strict; #-*-cperl-*- 2use warnings; 3 4use lib qw( ../../lib ../../../lib ../../../../lib); 5 6=head1 NAME 7 8Algorithm::Evolutionary::Op::Bitflip - Bit-flip mutation 9 10=head1 SYNOPSIS 11 12 my $op = new Algorithm::Evolutionary::Op::Bitflip 2; #Create from scratch with default rate 13 14=head1 Base Class 15 16L<Algorithm::Evolutionary::Op::Base|Algorithm::Evolutionary::Op::Base> 17 18=head1 DESCRIPTION 19 20Mutation operator for a GA; changes a single bit in the bitstring; 21does not need a rate 22 23=head1 METHODS 24 25=cut 26 27package Algorithm::Evolutionary::Op::Bitflip; 28 29our ($VERSION) = ( '$Revision: 3.4 $ ' =~ /(\d+\.\d+)/ ); 30 31use Carp; 32use Clone qw(clone); 33 34use base 'Algorithm::Evolutionary::Op::Base'; 35 36#Class-wide constants 37our $ARITY = 1; 38 39=head2 new( [$how_many] [,$priority] ) 40 41Creates a new mutation operator with a bitflip application rate, which defaults to 0.5, 42and an operator application rate (general for all ops), which defaults to 1. 43 44=cut 45 46sub new { 47 my $class = shift; 48 my $howMany = shift || 1; 49 my $rate = shift || 1; 50 51 my $hash = { howMany => $howMany || 1}; 52 my $self = Algorithm::Evolutionary::Op::Base::new( 'Algorithm::Evolutionary::Op::Bitflip', $rate, $hash ); 53 return $self; 54} 55 56=head2 create() 57 58Creates a new mutation operator. 59 60=cut 61 62sub create { 63 my $class = shift; 64 my $self = {}; 65 bless $self, $class; 66 return $self; 67} 68 69=head2 apply( $chromosome ) 70 71Applies mutation operator to a "Chromosome", a bitstring, really. Can be 72applied only to I<victims> composed of [0,1] atoms, independently of representation; but 73it checks before application that the operand is of type 74L<BitString|Algorithm::Evolutionary::Individual::BitString>. 75 76=cut 77 78sub apply ($;$){ 79 my $self = shift; 80 my $arg = shift || croak "No victim here!"; 81# my $victim = $arg->clone(); 82 my $victim; 83 if ( (ref $arg ) =~ /BitString/ ) { 84 $victim = clone( $arg ); 85 } else { 86 $victim = $arg->clone(); 87 } 88 my $size = $victim->size(); 89# croak "Incorrect type ".(ref $victim) if ! $self->check( $victim ); 90 croak "Too many changes" if $self->{_howMany} >= $size; 91 my @bits = 0..($size-1); # Hash with all bits 92 for ( my $i = 0; $i < $self->{_howMany}; $i++ ) { 93 my $rnd = int (rand( @bits )); 94 my $who = splice(@bits, $rnd, 1 ); 95 $victim->Atom( $who, $victim->Atom( $who )?0:1 ); 96 } 97 $victim->{'_fitness'} = undef ; 98 return $victim; 99} 100 101=head1 Copyright 102 103 This file is released under the GPL. See the LICENSE file included in this distribution, 104 or go to http://www.fsf.org/licenses/gpl.txt 105 106=cut 107 108