1use strict;
2use warnings;
3
4=head1 NAME
5
6Algorithm::Evolutionary::Op::Breeder - Even more customizable single generation for an evolutionary algorithm.
7
8=head1 SYNOPSIS
9
10    use Algorithm::Evolutionary qw( Individual::BitString
11    Op::Mutation Op::Crossover
12    Op::RouletteWheel
13    Op::Breeder);
14
15    use Algorithm::Evolutionary::Utils qw(average);
16
17    my @pop;
18    my $number_of_bits = 20;
19    my $population_size = 20;
20    my $replacement_rate = 0.5;
21    for ( 1..$population_size ) {
22      my $indi = new Algorithm::Evolutionary::Individual::BitString $number_of_bits ; #Creates random individual
23      $indi->evaluate( $onemax );
24      push( @pop, $indi );
25    }
26
27    my $m =  new Algorithm::Evolutionary::Op::Mutation 0.5;
28    my $c = new Algorithm::Evolutionary::Op::Crossover; #Classical 2-point crossover
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::Breeder( $selector, [$m, $c] );
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
46Breeder part of the evolutionary algorithm; takes a population and returns another created from the first
47
48=head1 METHODS
49
50=cut
51
52package Algorithm::Evolutionary::Op::Breeder;
53
54use lib qw(../../..);
55
56our $VERSION = '1.4';
57
58use Carp;
59
60use base 'Algorithm::Evolutionary::Op::Base';
61
62use Algorithm::Evolutionary qw(Wheel
63			       Op::Tournament_Selection);
64
65# Class-wide constants
66our $APPLIESTO =  'ARRAY';
67our $ARITY = 1;
68
69=head2 new( $ref_to_operator_array[, $selector = new Algorithm::Evolutionary::Op::Tournament_Selection 2 ] )
70
71Creates a breeder, with a selector and array of operators
72
73=cut
74
75sub new {
76  my $class = shift;
77  my $self = {};
78  $self->{'_ops'} = shift || croak "No operators found";
79  $self->{'_selector'} = shift
80    || new Algorithm::Evolutionary::Op::Tournament_Selection 2;
81  bless $self, $class;
82  return $self;
83}
84
85=head2 apply( $population[, $how_many || $population_size] )
86
87Applies the algorithm to the population, which should have
88been evaluated first; checks that it receives a
89ref-to-array as input, croaks if it does not.
90
91Returns a sorted, culled, evaluated population for next generation.
92
93=cut
94
95sub apply {
96    my $self = shift;
97    my $pop = shift || croak "No population here";
98    my $output_size = shift || @$pop; # Defaults to pop size
99    my @ops = @{$self->{'_ops'}};
100
101    #Select for breeding
102    my $selector = $self->{'_selector'};
103    my @genitors = $selector->apply( $pop );
104
105    #Reproduce
106    my $totRate = 0;
107    my @rates;
108    for ( @ops ) {
109	push( @rates, $_->{'rate'});
110    }
111    my $opWheel = new Algorithm::Evolutionary::Wheel @rates;
112
113    my @new_population;
114    for ( my $i = 0; $i < $output_size; $i++ ) {
115	my @offspring;
116	my $selectedOp = $ops[ $opWheel->spin()];
117	for ( my $j = 0; $j < $selectedOp->arity(); $j ++ ) {
118	    my $chosen = $genitors[ rand( @genitors )];
119#		print "Elegido ", $chosen->asString(), "\n";
120	    push( @offspring, $chosen->clone() );
121	}
122	my $mutante = $selectedOp->apply( @offspring );
123	push( @new_population, $mutante );
124    }
125
126    return \@new_population;
127}
128
129=head1 SEE ALSO
130
131More or less in the same ballpark, alternatives to this one
132
133=over 4
134
135=item *
136
137L<Algorithm::Evolutionary::Op::GeneralGeneration>
138
139=item *
140
141L<Algorithm::Evolutionary::Op::Breeder_Diverser>
142
143=item *
144
145L<Algorithm::Evolutionary::Op::Generation_Skeleton> does have a incompatible interface
146
147=back
148
149=head1 Copyright
150
151  This file is released under the GPL. See the LICENSE file included in this distribution,
152  or go to http://www.fsf.org/licenses/gpl.txt
153
154=cut
155
156"The truth is out there";
157