1use strict; #-*-cperl-*-
2use warnings;
3
4use lib qw(../../..);
5
6=head1 NAME
7
8Algorithm::Evolutionary::Op::Novelty_Mutation - Mutation guaranteeing new individual is not in the population
9
10=head1 SYNOPSIS
11
12  my $mmdp = new  Algorithm::Evolutionary::Fitness::MMDP;
13  my $bits = 36;
14  my @population;
15  for ( 1..100 ) { #Create and evaluate a population
16    my $indi = new Algorithm::Evolutionary::Individual::BitString $bits;
17    $indi->evaluate( $mmdp );
18    push @population, $indi;
19  }
20  my $nm = new Algorithm::Evolutionary::Op::Novelty_Mutation $mmdp->{'_cache'}; #Initialize using cache
21  $nm->apply($population[$i]);
22
23=head1 Base Class
24
25L<Algorithm::Evolutionary::Op::Base|Algorithm::Evolutionary::Op::Base>
26
27=head1 DESCRIPTION
28
29Attempts all possible mutations in order, until a "novelty" individual
30is found. Generated individuals are checked against the population
31hash, and discarded if they are already in the population.
32
33=head1 METHODS
34
35=cut
36
37package Algorithm::Evolutionary::Op::Novelty_Mutation;
38
39our $VERSION =   sprintf "%d.%03d", q$Revision: 3.1 $ =~ /(\d+)\.(\d+)/g; # Hack for avoiding version mismatch
40
41use Carp;
42use Clone qw(clone);
43
44use base 'Algorithm::Evolutionary::Op::Base';
45
46#Class-wide constants
47our $ARITY = 1;
48
49=head2 new( $ref_to_population_hash [,$priority] )
50
51Creates a new mutation operator with an operator application rate
52(general for all ops), which defaults to 1, and stores the reference
53to population hash.
54
55=cut
56
57sub new {
58  my $class = shift;
59  my $ref_to_population_hash = shift || croak "No pop hash here, fella!";
60  my $rate = shift || 1;
61
62  my $hash = { population_hashref => $ref_to_population_hash };
63  my $self = Algorithm::Evolutionary::Op::Base::new( 'Algorithm::Evolutionary::Op::Novelty_Mutation', $rate, $hash );
64  return $self;
65}
66
67=head2 apply( $chromosome )
68
69Applies mutation operator to a "Chromosome", a bitstring, really. Can be
70applied only to I<victims> composed of [0,1] atoms, independently of representation; but
71it checks before application that the operand is of type
72L<BitString|Algorithm::Evolutionary::Individual::BitString>.
73
74=cut
75
76sub apply ($;$){
77  my $self = shift;
78  my $arg = shift || croak "No victim here!";
79  my $test_clone;
80  my $size =  $arg->size();
81  for ( my $i = 0; $i < $size; $i++ ) {
82    if ( (ref $arg ) =~ /BitString/ ) {
83      $test_clone = clone( $arg );
84    } else {
85      $test_clone = $arg->clone();
86    }
87    $test_clone->Atom( $i, $test_clone->Atom( $i )?0:1 );
88    last if !$self->{'_population_hashref'}->{$test_clone->Chrom()}; #Exit if not found in the population
89  }
90  if ( $test_clone->Chrom() eq $arg->Chrom() ) { # Nothing done, zap
91    for ( my $i = 0; $i < $size; $i++ ) {
92      $test_clone->Atom( $i, (rand(100)>50)?0:1 );
93    }
94  }
95  $test_clone->{'_fitness'} = undef ;
96  return $test_clone;
97}
98
99=head1 Copyright
100
101  This file is released under the GPL. See the LICENSE file included in this distribution,
102  or go to http://www.fsf.org/licenses/gpl.txt
103
104  CVS Info: $Date: 2011/02/14 06:55:36 $
105  $Header: /media/Backup/Repos/opeal/opeal/Algorithm-Evolutionary/lib/Algorithm/Evolutionary/Op/Novelty_Mutation.pm,v 3.1 2011/02/14 06:55:36 jmerelo Exp $
106  $Author: jmerelo $
107  $Revision: 3.1 $
108  $Name $
109
110=cut
111
112