File Coverage

lib/Algorithm/Evolutionary/Op/Convergence_Terminator.pm
Criterion Covered Total %
statement 9 9 100.0
branch n/a
condition n/a
subroutine 3 3 100.0
pod n/a
total 12 12 100.0


line stmt bran cond sub pod time code
1 1     1   25645 use strict; #-*-cperl-*-
  1         3  
  1         32  
2 1     1   4 use warnings;
  1         2  
  1         103  
3              
4             =head1 NAME
5              
6             Algorithm::Evolutionary::Op::Convergence_Terminator - Checks for termination of an algorithm, returns true if a certain percentage of the population is the same
7            
8             =head1 SYNOPSIS
9              
10             my $ct = new Algorithm::Evolutionary::Op::Convergence_Terminator 0.5;
11             do {
12             $generation->apply($pop_hashref );
13             } until ($ct->apply( $pop_hashref );
14              
15             =head1 Base Class
16              
17             L
18              
19             =head1 DESCRIPTION
20              
21             Checks for termination after if population has converged
22              
23             =head1 METHODS
24              
25             =cut
26              
27             package Algorithm::Evolutionary::Op::Convergence_Terminator;
28              
29             our ($VERSION) = ( '$Revision: 3.1 $ ' =~ / (\d+\.\d+)/ ) ;
30              
31 1     1   5 use base 'Algorithm::Evolutionary::Op::Base';
  1         2  
  1         433  
32              
33             =head2 new( [$population_proportion = 0.5] )
34              
35             Creates a new generational terminator:
36              
37             my $ct = new Algorithm::Evolutionary::Op::Convergence_Terminator 0.5;
38              
39             will make the C method return false after if 50% of the
40             population are the same, that is, its "genetic" representation is equal.
41              
42             =cut
43              
44             sub new {
45             my $class = shift;
46             my $hash = { proportion => shift || 0.5 };
47             my $self = Algorithm::Evolutionary::Op::Base::new( __PACKAGE__, 1, $hash );
48             return $self;
49             }
50              
51             =head2 apply()
52              
53             Checks for population convergence
54              
55             =cut
56              
57             sub apply ($) {
58             my $self = shift;
59             my $population = shift;
60             my %population_hash;
61             for my $p (@$population ) {
62             $population_hash{$p->as_string()}++;
63             }
64             my $convergence =0;
65             for my $k ( keys %population_hash ) {
66             if ( $population_hash{$k}/@$population >= $self->{'_proportion'} ) {
67             $convergence =1;
68             last;
69             }
70             }
71             return $convergence;
72            
73             }
74            
75             =head1 See Also
76              
77             L needs an object of this class to check
78             for the termination condition. It's normally used alongside "generation-type"
79             objects such as L
80              
81             There are other options for termination conditions: L and
82             L.
83              
84              
85             =head1 Copyright
86            
87             This file is released under the GPL. See the LICENSE file included in this distribution,
88             or go to http://www.fsf.org/licenses/gpl.txt
89              
90             CVS Info: $Date: 2009/07/28 11:30:56 $
91             $Header: /cvsroot/opeal/Algorithm-Evolutionary/lib/Algorithm/Evolutionary/Op/Convergence_Terminator.pm,v 3.1 2009/07/28 11:30:56 jmerelo Exp $
92             $Author: jmerelo $
93             $Revision: 3.1 $
94             $Name $
95              
96             =cut
97              
98             "The truth is out there";