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