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