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