1use strict; #-*-cperl-*- 2use warnings; 3 4use lib qw( ../../../../lib ); 5 6=head1 NAME 7 8Algorithm::Evolutionary::Op::Tournament_Selection - Tournament selector, takes individuals from one population and puts them into another 9 10=head1 SYNOPSIS 11 12 my $popSize = 100; 13 my $tournamentSize = 7; 14 my $selector = new Algorithm::Evolutionary::Op::Tournament_Selection $tournamentSize; 15 my @newPop = $selector->apply( @pop ); #Creates a new population from old 16 17=head1 Base Class 18 19L<Algorithm::Evolutionary::Op::Selector> 20 21=head1 DESCRIPTION 22 23One of the possible selectors used for selecting the pool of individuals 24that are going to be the parents of the following generation. Takes a 25set of individuals randomly out of the population, and select the best. 26 27=head1 METHODS 28 29=cut 30 31 32package Algorithm::Evolutionary::Op::Tournament_Selection; 33 34use Carp; 35 36our $VERSION = '1.5'; 37 38use base 'Algorithm::Evolutionary::Op::Base'; 39 40=head2 new( $output_population_size, $tournament_size ) 41 42Creates a new tournament selector 43 44=cut 45 46sub new { 47 my $class = shift; 48 my $self = Algorithm::Evolutionary::Op::Base::new($class ); 49 $self->{'_tournament_size'} = shift || 2; 50 bless $self, $class; 51 return $self; 52} 53 54=head2 apply( $ref_to_population[, $output_size || @$ref_to_population] ) 55 56Applies the tournament selection to a population, returning another of 57the same size by default or whatever size is selected. Please bear in 58mind that, unlike other selectors, this one uses a reference to 59population instead of a population array. 60 61=cut 62 63sub apply ($$) { 64 my $self = shift; 65 my $pop = shift || croak "No pop"; 66 my $output_size = shift || @$pop; 67 my @output; 68 for ( my $i = 0; $i < $output_size; $i++ ) { 69 #Randomly select a few guys 70 my $best = $pop->[ rand( @$pop ) ]; 71 for ( my $j = 1; $j < $self->{'_tournament_size'}; $j++ ) { 72 my $this_one = $pop->[ rand( @$pop ) ]; 73 if ( $this_one->{'_fitness'} > $best->{'_fitness'} ) { 74 $best = $this_one; 75 } 76 } 77 #Sort by fitness 78 push @output, $best; 79 } 80 return @output; 81} 82 83=head1 See Also 84 85L<Algorithm::Evolutionary::Op::RouleteWheel> is another option for 86selecting a pool of individuals 87 88=head1 Copyright 89 90 This file is released under the GPL. See the LICENSE file included in this distribution, 91 or go to http://www.fsf.org/licenses/gpl.txt 92 93=cut 94 95"The truth is in here"; 96