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