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