1use strict; #-*-cperl-*- 2use warnings; 3 4use lib qw( ../../.. ); 5 6=head1 NAME 7 8Algorithm::Evolutionary::Op::Easy - evolutionary algorithm, single generation, with 9 variable operators. 10 11 12=head1 SYNOPSIS 13 14 my $easy_EA = new Algorithm::Evolutionary::Op::Easy $fitness_func; 15 16 for ( my $i = 0; $i < $max_generations; $i++ ) { 17 print "<", "="x 20, "Generation $i", "="x 20, ">\n"; 18 $easy_EA->apply(\@pop ); 19 for ( @pop ) { 20 print $_->asString, "\n"; 21 } 22 } 23 24 #Define a default algorithm with predefined evaluation function, 25 #Mutation and crossover. Default selection rate is 0.4 26 my $algo = new Algorithm::Evolutionary::Op::Easy( $eval ); 27 28 #Define an easy single-generation algorithm with predefined mutation and crossover 29 my $m = new Algorithm::Evolutionary::Op::Bitflip; #Changes a single bit 30 my $c = new Algorithm::Evolutionary::Op::Crossover; #Classical 2-point crossover 31 my $generation = new Algorithm::Evolutionary::Op::Easy( $rr, 0.2, [$m, $c] ); 32 33=head1 Base Class 34 35L<Algorithm::Evolutionary::Op::Base> 36 37=cut 38 39=head1 DESCRIPTION 40 41"Easy" to use, single generation of an evolutionary algorithm. Takes 42an arrayref of operators as input, or defines bitflip-mutation and 432-point crossover as default. The C<apply> method applies a single 44iteration of the algorithm to the population it takes as input 45 46=head1 METHODS 47 48=cut 49 50package Algorithm::Evolutionary::Op::Easy; 51 52our ($VERSION) = ( '$Revision: 3.5 $ ' =~ / (\d+\.\d+)/ ) ; 53 54use Carp; 55 56use Algorithm::Evolutionary::Wheel; 57use Algorithm::Evolutionary::Op::Bitflip; 58use Algorithm::Evolutionary::Op::Crossover; 59 60use base 'Algorithm::Evolutionary::Op::Base'; 61 62# Class-wide constants 63our $APPLIESTO = 'ARRAY'; 64 65=head2 new( $eval_func, [$operators_arrayref] ) 66 67Creates an algorithm that optimizes the handled fitness function and 68reference to an array of operators. If this reference is null, an 69array consisting of bitflip mutation and 2 point crossover is 70generated. Which, of course, might not what you need in case you 71don't have a binary chromosome. 72 73=cut 74 75sub new { 76 my $class = shift; 77 my $self = {}; 78 $self->{_eval} = shift || croak "No eval function found"; 79 $self->{_selrate} = shift || 0.4; 80 if ( @_ ) { 81 $self->{_ops} = shift; 82 } else { 83 #Create mutation and crossover 84 my $mutation = new Algorithm::Evolutionary::Op::Bitflip; 85 push( @{$self->{_ops}}, $mutation ); 86 my $xover = new Algorithm::Evolutionary::Op::Crossover; 87 push( @{$self->{_ops}}, $xover ); 88 } 89 bless $self, $class; 90 return $self; 91 92} 93 94=head2 set( $hashref, codehash, opshash ) 95 96Sets the instance variables. Takes a ref-to-hash (for options), codehash (for fitness) and opshash (for operators) 97 98=cut 99 100sub set { 101 my $self = shift; 102 my $hashref = shift || croak "No params here"; 103 my $codehash = shift || croak "No code here"; 104 my $opshash = shift || croak "No ops here"; 105 $self->{_selrate} = $hashref->{selrate}; 106 107 for ( keys %$codehash ) { 108 $self->{"_$_"} = eval "sub { $codehash->{$_} } " || carp "Error compiling fitness function: $! => $@"; 109 } 110 111 $self->{_ops} =(); 112 for ( keys %$opshash ) { 113 #First element of the array contains the content, second the rate. 114 push @{$self->{_ops}}, 115 Algorithm::Evolutionary::Op::Base::fromXML( $_, $opshash->{$_}->[1], $opshash->{$_}->[0] ); 116 } 117} 118 119=head2 apply( $population ) 120 121Applies the algorithm to the population; checks that it receives a 122ref-to-array as input, croaks if it does not. Returns a sorted, 123culled, evaluated population for next generation. 124 125=cut 126 127sub apply ($) { 128 my $self = shift; 129 my $pop = shift || croak "No population here"; 130 131 #Evaluate 132 my $eval = $self->{_eval}; 133 my @ops = @{$self->{_ops}}; 134 my @popEval; 135 for ( @$pop ) { 136 my $fitness; #Evaluates only those that have no fitness 137 if ( !defined ($_->Fitness() ) ) { 138 $_->evaluate( $eval ); 139 } 140 push @popEval, $_; 141 } 142 143 #Sort by fitness 144 my @popsort = sort { $b->{_fitness} <=> $a->{_fitness}; } 145 @popEval ; 146 147 #Cull 148 my $pringaos = int(($#popsort+1)*$self->{_selrate}); #+1 gives you size 149 splice @popsort, -$pringaos; 150 151 #Reproduce 152 my @rates = map( $_->{'rate'}, @ops ); 153 my $opWheel = new Algorithm::Evolutionary::Wheel @rates; 154 155 #Generate offpring; 156 my $originalSize = $#popsort; # Just for random choice 157 for ( my $i = 0; $i < $pringaos; $i ++ ) { 158 my @offspring; 159 my $selectedOp = $ops[ $opWheel->spin()]; 160 croak "Problems with selected operator" if !$selectedOp; 161 for ( my $j = 0; $j < $selectedOp->arity(); $j ++ ) { 162 my $chosen = $popsort[ int ( rand( $originalSize ) )]; 163 push( @offspring, $chosen ); #No need to clone, it's not changed in ops 164 } 165# p rint "Op ", ref $selectedOp, "\n"; 166# if ( (ref $selectedOp ) =~ /ssover/ ) { 167# print map( $_->{'_str'}."\n", @offspring ); 168# } 169 my $mutante = $selectedOp->apply( @offspring ); 170 croak "Error aplying operator" if !$mutante; 171 # print "Mutante ", $mutante->{'_str'}, "\n"; 172 push( @popsort, $mutante ); 173 } 174 175 #Return 176 @$pop = @popsort; 177 178} 179 180=head1 SEE ALSO 181 182L<Algorithm::Evolutionary::Op::CanonicalGA>. 183L<Algorithm::Evolutionary::Op::FullAlgorithm>. 184 185 186=head1 Copyright 187 188This file is released under the GPL. See the LICENSE file included in this distribution, 189or go to http://www.fsf.org/licenses/gpl.txt 190 191 192=cut 193 194"The truth is out there"; 195