1use strict; 2use warnings; 3 4=head1 NAME 5 6Algorithm::Evolutionary::Op::Generation_Skeleton - Even more customizable single generation for an evolutionary algorithm. 7 8=head1 SYNOPSIS 9 10 use Algorithm::Evolutionary qw( Individual::BitString 11 Op::Mutation Op::Crossover 12 Op::RouletteWheel 13 Fitness::ONEMAX Op::Generation_Skeleton 14 Op::Replace_Worst); 15 16 use Algorithm::Evolutionary::Utils qw(average); 17 18 my $onemax = new Algorithm::Evolutionary::Fitness::ONEMAX; 19 20 my @pop; 21 my $number_of_bits = 20; 22 my $population_size = 20; 23 my $replacement_rate = 0.5; 24 for ( 1..$population_size ) { 25 my $indi = new Algorithm::Evolutionary::Individual::BitString $number_of_bits ; #Creates random individual 26 $indi->evaluate( $onemax ); 27 push( @pop, $indi ); 28 } 29 30 my $m = new Algorithm::Evolutionary::Op::Mutation 0.5; 31 my $c = new Algorithm::Evolutionary::Op::Crossover; #Classical 2-point crossover 32 33 my $selector = new Algorithm::Evolutionary::Op::RouletteWheel $population_size; #One of the possible selectors 34 35 my $generation = 36 new Algorithm::Evolutionary::Op::Generation_Skeleton( $onemax, $selector, [$m, $c], $replacement_rate ); 37 38 my @sortPop = sort { $b->Fitness() <=> $a->Fitness() } @pop; 39 my $bestIndi = $sortPop[0]; 40 my $previous_average = average( \@sortPop ); 41 $generation->apply( \@sortPop ); 42 43=head1 Base Class 44 45L<Algorithm::Evolutionary::Op::Base> 46 47=head1 DESCRIPTION 48 49Skeleton class for a general single-generation (or single step) in an 50evolutionary algorithm; its instantiation requires a 51L<fitness|Algorithm::Evolutionary::Fitness::Base> function, a 52L<Selector|Algorithm::Evolutionary::Op::Selector>, a reference to an 53array of operators and a replacement operator 54 55=head1 METHODS 56 57=cut 58 59package Algorithm::Evolutionary::Op::Generation_Skeleton; 60 61use lib qw(../../..); 62 63our $VERSION = '3.3'; 64 65use Carp; 66 67use base 'Algorithm::Evolutionary::Op::Base'; 68 69use Algorithm::Evolutionary qw(Wheel Op::Replace_Worst); 70use Sort::Key qw( rnkeysort); 71 72# Class-wide constants 73our $APPLIESTO = 'ARRAY'; 74our $ARITY = 1; 75 76=head2 new( $evaluation_function, $selector, $ref_to_operator_array, $replacement_operator ) 77 78Creates an algorithm, with no defaults except for the default 79replacement operator (defaults to L<Algorithm::Evolutionary::Op::ReplaceWorst>) 80 81=cut 82 83sub new { 84 my $class = shift; 85 my $self = {}; 86 $self->{_eval} = shift || croak "No eval function found"; 87 $self->{_selector} = shift || croak "No selector found"; 88 $self->{_ops} = shift || croak "No operators found"; 89 $self->{_replacementRate} = shift || 1; #Default to all replaced 90 $self->{_replacement_op} = shift || new Algorithm::Evolutionary::Op::Replace_Worst; 91 bless $self, $class; 92 return $self; 93} 94 95 96=head2 set( $ref_to_params_hash, $ref_to_code_hash, $ref_to_operators_hash ) 97 98Sets the instance variables. Takes a ref-to-hash as 99input. Not intended to be used from outside the class 100 101=cut 102 103sub set { 104 my $self = shift; 105 my $hashref = shift || croak "No params here"; 106 my $codehash = shift || croak "No code here"; 107 my $opshash = shift || croak "No ops here"; 108 109 for ( keys %$codehash ) { 110 $self->{"_$_"} = eval "sub { $codehash->{$_} } "; 111 } 112 113 $self->{_ops} =(); 114 for ( keys %$opshash ) { 115 push @{$self->{_ops}}, 116 Algorithm::Evolutionary::Op::Base::fromXML( $_, $opshash->{$_}->[1], $opshash->{$_}->[0] ) ; 117 } 118} 119 120=head2 apply( $population ) 121 122Applies the algorithm to the population, which should have 123been evaluated first; checks that it receives a 124ref-to-array as input, croaks if it does not. Returns a sorted, 125culled, evaluated population for next generation. 126 127=cut 128 129sub apply ($) { 130 my $self = shift; 131 my $pop = shift || croak "No population here"; 132 croak "Incorrect type ".(ref $pop) if ref( $pop ) ne $APPLIESTO; 133 134 #Breed 135 my $selector = $self->{'_selector'}; 136 my @genitors = $selector->apply( @$pop ); 137 138 #Reproduce 139 my $totRate = 0; 140 my @rates; 141 my @ops = @{$self->{'_ops'}}; 142 for ( @ops ) { 143 push( @rates, $_->{'rate'}); 144 } 145 my $opWheel = new Algorithm::Evolutionary::Wheel @rates; 146 147 my @newpop; 148 my $pringaos = @$pop * $self->{'_replacementRate'} ; 149 for ( my $i = 0; $i < $pringaos; $i++ ) { 150 my @offspring; 151 my $selectedOp = $ops[ $opWheel->spin()]; 152# print $selectedOp->asXML; 153 for ( my $j = 0; $j < $selectedOp->arity(); $j ++ ) { 154 my $chosen = $genitors[ rand( @genitors )]; 155# print "Elegido ", $chosen->asString(), "\n"; 156 push( @offspring, $chosen->clone() ); 157 } 158 my $mutante = $selectedOp->apply( @offspring ); 159 push( @newpop, $mutante ); 160 } 161 162 my $eval = $self->{'_eval'}; 163 map( $_->evaluate( $eval), @newpop ); 164 165 #Eliminate and substitute 166 my $pop_hash = $self->{'_replacement_op'}->apply( $pop, \@newpop ); 167 @$pop = rnkeysort { $_->{'_fitness'} } @$pop_hash ; 168} 169 170=head1 SEE ALSO 171 172More or less in the same ballpark, alternatives to this one 173 174=over 4 175 176=item * 177 178L<Algorithm::Evolutionary::Op::GeneralGeneration> 179 180=back 181 182=head1 Copyright 183 184This file is released under the GPL. See the LICENSE file included in this distribution, 185or go to http://www.fsf.org/licenses/gpl.txt 186 187=cut 188 189"The truth is out there"; 190