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