1use strict; #-*-cperl-*-
2use warnings;
3
4use lib qw( ../../.. );
5
6=head1 NAME
7
8Algorithm::Evolutionary::Op::Easy - evolutionary algorithm, single generation, with
9                    variable operators.
10
11
12=head1 SYNOPSIS
13
14  my $easy_EA = new Algorithm::Evolutionary::Op::Easy $fitness_func;
15
16  for ( my $i = 0; $i < $max_generations; $i++ ) {
17    print "<", "="x 20, "Generation $i", "="x 20, ">\n";
18    $easy_EA->apply(\@pop );
19    for ( @pop ) {
20      print $_->asString, "\n";
21    }
22  }
23
24  #Define a default algorithm with predefined evaluation function,
25  #Mutation and crossover. Default selection rate is 0.4
26  my $algo = new Algorithm::Evolutionary::Op::Easy( $eval );
27
28  #Define an easy single-generation algorithm with predefined mutation and crossover
29  my $m = new Algorithm::Evolutionary::Op::Bitflip; #Changes a single bit
30  my $c = new Algorithm::Evolutionary::Op::Crossover; #Classical 2-point crossover
31  my $generation = new Algorithm::Evolutionary::Op::Easy( $rr, 0.2, [$m, $c] );
32
33=head1 Base Class
34
35L<Algorithm::Evolutionary::Op::Base>
36
37=cut
38
39=head1 DESCRIPTION
40
41"Easy" to use, single generation of an evolutionary algorithm. Takes
42an arrayref of operators as input, or defines bitflip-mutation and
432-point crossover as default. The C<apply> method applies a single
44iteration of the algorithm to the population it takes as input
45
46=head1 METHODS
47
48=cut
49
50package Algorithm::Evolutionary::Op::Easy;
51
52our ($VERSION) = ( '$Revision: 3.5 $ ' =~ / (\d+\.\d+)/ ) ;
53
54use Carp;
55
56use Algorithm::Evolutionary::Wheel;
57use Algorithm::Evolutionary::Op::Bitflip;
58use Algorithm::Evolutionary::Op::Crossover;
59
60use base 'Algorithm::Evolutionary::Op::Base';
61
62# Class-wide constants
63our $APPLIESTO =  'ARRAY';
64
65=head2 new( $eval_func, [$operators_arrayref] )
66
67Creates an algorithm that optimizes the handled fitness function and
68reference to an array of operators. If this reference is null, an
69array consisting of bitflip mutation and 2 point crossover is
70generated. Which, of course, might not what you need in case you
71don't have a binary chromosome.
72
73=cut
74
75sub new {
76  my $class = shift;
77  my $self = {};
78  $self->{_eval} = shift || croak "No eval function found";
79  $self->{_selrate} = shift || 0.4;
80  if ( @_ ) {
81      $self->{_ops} = shift;
82  } else {
83      #Create mutation and crossover
84      my $mutation = new Algorithm::Evolutionary::Op::Bitflip;
85      push( @{$self->{_ops}}, $mutation );
86      my $xover = new Algorithm::Evolutionary::Op::Crossover;
87      push( @{$self->{_ops}}, $xover );
88  }
89  bless $self, $class;
90  return $self;
91
92}
93
94=head2 set( $hashref, codehash, opshash )
95
96Sets the instance variables. Takes a ref-to-hash (for options), codehash (for fitness) and opshash (for operators)
97
98=cut
99
100sub set {
101  my $self = shift;
102  my $hashref = shift || croak "No params here";
103  my $codehash = shift || croak "No code here";
104  my $opshash = shift || croak "No ops here";
105  $self->{_selrate} = $hashref->{selrate};
106
107  for ( keys %$codehash ) {
108    $self->{"_$_"} =  eval "sub {  $codehash->{$_} } " || carp "Error compiling fitness function: $! => $@";
109  }
110
111  $self->{_ops} =();
112  for ( keys %$opshash ) {
113    #First element of the array contains the content, second the rate.
114    push @{$self->{_ops}},
115      Algorithm::Evolutionary::Op::Base::fromXML( $_, $opshash->{$_}->[1], $opshash->{$_}->[0] );
116  }
117}
118
119=head2 apply( $population )
120
121Applies the algorithm to the population; checks that it receives a
122ref-to-array as input, croaks if it does not. Returns a sorted,
123culled, evaluated population for next generation.
124
125=cut
126
127sub apply ($) {
128  my $self = shift;
129  my $pop = shift || croak "No population here";
130
131  #Evaluate
132  my $eval = $self->{_eval};
133  my @ops = @{$self->{_ops}};
134  my @popEval;
135  for ( @$pop ) {
136    my $fitness;  #Evaluates only those that have no fitness
137    if ( !defined ($_->Fitness() ) ) {
138      $_->evaluate( $eval );
139    }
140    push @popEval, $_;
141  }
142
143  #Sort by fitness
144  my @popsort = sort { $b->{_fitness} <=> $a->{_fitness}; }
145    @popEval ;
146
147  #Cull
148  my $pringaos = int(($#popsort+1)*$self->{_selrate}); #+1 gives you size
149  splice @popsort, -$pringaos;
150
151  #Reproduce
152  my @rates = map( $_->{'rate'}, @ops );
153  my $opWheel = new Algorithm::Evolutionary::Wheel @rates;
154
155  #Generate offpring;
156  my $originalSize = $#popsort; # Just for random choice
157  for ( my $i = 0; $i < $pringaos; $i ++ ) {
158      my @offspring;
159      my $selectedOp = $ops[ $opWheel->spin()];
160      croak "Problems with selected operator" if !$selectedOp;
161      for ( my $j = 0; $j < $selectedOp->arity(); $j ++ ) {
162	my $chosen = $popsort[ int ( rand( $originalSize ) )];
163	push( @offspring, $chosen ); #No need to clone, it's not changed in ops
164      }
165#     p rint "Op ", ref $selectedOp, "\n";
166#      if ( (ref $selectedOp ) =~ /ssover/ ) {
167#	print map( $_->{'_str'}."\n", @offspring );
168#      }
169      my $mutante = $selectedOp->apply( @offspring );
170      croak "Error aplying operator" if !$mutante;
171 #     print "Mutante ", $mutante->{'_str'}, "\n";
172      push( @popsort, $mutante );
173  }
174
175  #Return
176  @$pop = @popsort;
177
178}
179
180=head1 SEE ALSO
181
182L<Algorithm::Evolutionary::Op::CanonicalGA>.
183L<Algorithm::Evolutionary::Op::FullAlgorithm>.
184
185
186=head1 Copyright
187
188This file is released under the GPL. See the LICENSE file included in this distribution,
189or go to http://www.fsf.org/licenses/gpl.txt
190
191
192=cut
193
194"The truth is out there";
195