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