1use strict; 2use warnings; 3 4=head1 NAME 5 6Algorithm::Evolutionary::Op::EDA_step - Single step for a Estimation of Distribution 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::EDA_step 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 $selector = new Algorithm::Evolutionary::Op::RouletteWheel $population_size; #One of the possible selectors 31 32 my $generation = 33 new Algorithm::Evolutionary::Op::EDA_step( $onemax, $selector, $replacement_rate ); 34 35 my @sortPop = sort { $b->Fitness() <=> $a->Fitness() } @pop; 36 my $bestIndi = $sortPop[0]; 37 my $previous_average = average( \@sortPop ); 38 $generation->apply( \@sortPop ); 39 40=head1 Base Class 41 42L<Algorithm::Evolutionary::Op::Base> 43 44=head1 DESCRIPTION 45 46Estimation of Distribution Algorithms shun operators and instead try 47to model the distribution of "good" solutions in the population. This 48version corresponds to the most basic one. 49 50=head1 METHODS 51 52=cut 53 54package Algorithm::Evolutionary::Op::EDA_step; 55 56use lib qw(../../..); 57 58our ($VERSION) = ( '$Revision: 1.5 $ ' =~ / (\d+\.\d+)/ ) ; 59 60use Carp; 61 62use base 'Algorithm::Evolutionary::Op::Base'; 63 64use Algorithm::Evolutionary qw(Hash_Wheel Individual::String); 65 66# Class-wide constants 67our $APPLIESTO = 'ARRAY'; 68our $ARITY = 1; 69 70=head2 new( $evaluation_function, $replacement_rate ) 71 72Creates an algorithm, with no defaults except for the default 73replacement operator (defaults to L<Algorithm::Evolutionary::Op::ReplaceWorst>) 74 75=cut 76 77sub new { 78 my $class = shift; 79 my $self = {}; 80 $self->{_eval} = shift || croak "No eval function found"; 81 $self->{_replacementRate} = shift || 0.5; #Default to half replaced 82 $self->{_population_size} = shift || 100; #Default 83 $self->{_alphabet} = shift || [ 0, 1]; #Default 84 bless $self, $class; 85 return $self; 86} 87 88 89=head2 set( $ref_to_params_hash, $ref_to_code_hash, $ref_to_operators_hash ) 90 91Sets the instance variables. Takes a ref-to-hash as 92input. Not intended to be used from outside the class 93 94=cut 95 96sub set { 97 my $self = shift; 98 my $hashref = shift || croak "No params here"; 99 my $codehash = shift || croak "No code here"; 100 my $opshash = shift || croak "No ops here"; 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 reset( $population ) 114 115Start all over again by resetting the population 116 117=cut 118 119sub reset { 120 my $self = shift; 121 my $population = shift; 122 my $length = $population->[0]->size; 123 @$population = (); 124 my @alphabet = @{$self->{'_alphabet'}}; 125 for ( my $p= 0; $p < $self->{'_population_size'}; $p++ ) { 126 my $string = ''; 127 for ( my $i = 0; $i < $length; $i++ ) { 128 $string .= $alphabet[rand( @alphabet )]; 129 } 130 my $new_one = Algorithm::Evolutionary::Individual::String->fromString( $string ); 131 push @$population, $new_one; 132 } 133} 134 135=head2 apply( $population ) 136 137Applies the algorithm to the population, which should have 138been evaluated first; checks that it receives a 139ref-to-array as input, croaks if it does not. Returns a sorted, 140culled, evaluated population for next generation. 141 142=cut 143 144sub apply ($) { 145 my $self = shift; 146 my $pop = shift || croak "No population here"; 147 croak "Incorrect type ".(ref $pop) if ref( $pop ) ne $APPLIESTO; 148 149 #Evaluate only the new ones 150 my $eval = $self->{_eval}; 151 for my $p ( @{$pop} ) { 152 $p->evaluate( $eval) if !$p->Fitness(); 153 } 154 my @ranked_pop = sort { $b->{_fitness} <=> $a->{_fitness}; } @$pop; 155 156 #Eliminate 157 my $pringaos = @$pop * $self->{_replacementRate} ; 158 splice( @ranked_pop, -$pringaos ); 159 160 #Check distribution of remaining pop 161 my $how_many = @ranked_pop; 162 my @occurrences; 163 my $length = $pop->[0]->size; 164 for my $p ( @ranked_pop ) { 165 for ( my $i = 0; $i < $length; $i++ ) { 166 if ( ! defined $occurrences[$i] ) { 167 $occurrences[$i] = {}; 168 } 169 my $this_value = $p->Atom($i); 170 $occurrences[$i]->{$this_value}++; 171 } 172 } 173 my @wheel; 174 for ( my $i = 0; $i < $length; $i++ ) { 175 for my $k ( @{$self->{'_alphabet'}} ) { 176 if ( $occurrences[$i]->{$k} ) { 177 $occurrences[$i]->{$k} /= $how_many; 178 } else { 179 $occurrences[$i]->{$k} = 0.05; #Minimum to avoid stagnation 180 } 181 } 182 $wheel[$i] = new Algorithm::Evolutionary::Hash_Wheel $occurrences[$i]; 183 } 184 185 #Generate new population 186 for ( my $p= 0; $p < $self->{'_population_size'} - $pringaos; $p++ ) { 187 my $string = ''; 188 for ( my $i = 0; $i < $length; $i++ ) { 189 $string .= $wheel[$i]->spin; 190 } 191 my $new_one = Algorithm::Evolutionary::Individual::String->fromString( $string ); 192 push @ranked_pop, $new_one; 193 } 194 @$pop = @ranked_pop; # Population is sorted 195} 196 197=head1 SEE ALSO 198 199More or less in the same ballpark, alternatives to this one 200 201=over 4 202 203=item * 204 205L<Algorithm::Evolutionary::Op::GeneralGeneration> 206 207=back 208 209=head1 Copyright 210 211 This file is released under the GPL. See the LICENSE file included in this distribution, 212 or go to http://www.fsf.org/licenses/gpl.txt 213 214 CVS Info: $Date: 2009/09/30 16:01:28 $ 215 $Header: /media/Backup/Repos/opeal/opeal/Algorithm-Evolutionary/lib/Algorithm/Evolutionary/Op/EDA_step.pm,v 1.5 2009/09/30 16:01:28 jmerelo Exp $ 216 $Author: jmerelo $ 217 $Revision: 1.5 $ 218 219=cut 220 221"The truth is out there"; 222