File Coverage

lib/Algorithm/Evolutionary/Op/Replace_Different.pm
Criterion Covered Total %
statement 15 15 100.0
branch n/a
condition n/a
subroutine 5 5 100.0
pod n/a
total 20 20 100.0


line stmt bran cond sub pod time code
1 1     1   3 use strict; #-*-cperl-*-
  1         1  
  1         29  
2 1     1   4 use warnings;
  1         1  
  1         21  
3              
4 1     1   4 use lib qw( ../../.. );
  1         1  
  1         4  
5              
6             =head1 NAME
7              
8             Algorithm::Evolutionary::Op::Replace_Different - Incorporate
9             individuals into the population replacing the worst ones but only if
10             they are different.
11              
12             =head1 SYNOPSIS
13              
14             my $op = new Algorithm::Evolutionary::Op::Replace_Different;
15             $op->apply( $old_population_hashref, $new_population_hashref );
16              
17             =head1 Base Class
18              
19             L
20              
21             =head1 DESCRIPTION
22              
23             Replaces only unique individuals, avoiding to introduce copies of them
24             into the new population .
25              
26             =head1 METHODS
27              
28             =cut
29              
30             package Algorithm::Evolutionary::Op::Replace_Different;
31              
32             our $VERSION = sprintf "%d.%d", q$Revision: 1.3 $ =~ /(\d+)\.(\d+)/g;
33              
34 1     1   131 use Carp;
  1         1  
  1         52  
35              
36 1     1   5 use base 'Algorithm::Evolutionary::Op::Base';
  1         1  
  1         69  
37              
38             use Sort::Key qw(nkeysort);
39              
40             #Class-wide constants
41             our $ARITY = 1;
42              
43             =head2 apply( $population, $chromosome_list )
44              
45             Eliminates the worst individuals in the population, replacing them
46             by the list of new chromosomes, but only if they are different to the ones already present. The population must be evaluated,
47             but there's no need to have it sorted in advance. It returns a
48             sorted population.
49              
50             =cut
51              
52             sub apply ($;$){
53             my $self = shift;
54             my $population = shift || croak "No population here!";
55             my $chromosome_list = shift || croak "No new population here!";
56            
57             #Sort
58             my @sorted_population = nkeysort { $_->Fitness() } @$population ;
59              
60             my %population_hash;
61             map( $population_hash{$_->{'_str'}} = 1, @sorted_population );
62              
63             my @non_repeated = grep( !$population_hash{$_->{'_str'}}, @$chromosome_list );
64             my $to_eliminate = scalar @non_repeated;
65             if ( $to_eliminate > 0 ) {
66             # print "Eliminating $to_eliminate\n";
67             splice ( @sorted_population, 0, $to_eliminate );
68             push @sorted_population, @non_repeated;
69             }
70             return \@sorted_population;
71              
72             }
73              
74             =head1 SEE ALSO
75              
76             L, where the
77             replacement policy is one of the parameters.
78              
79             It can also be used in L for
80             insertion of new individuals asynchronously.
81              
82             Another breeder is L.
83              
84             =head1 Copyright
85            
86             This file is released under the GPL. See the LICENSE file included in this distribution,
87             or go to http://www.fsf.org/licenses/gpl.txt
88              
89             CVS Info: $Date: 2013/01/05 12:43:32 $
90             $Header: /media/Backup/Repos/opeal/opeal/Algorithm-Evolutionary/lib/Algorithm/Evolutionary/Op/Replace_Different.pm,v 1.3 2013/01/05 12:43:32 jmerelo Exp $
91             $Author: jmerelo $
92             $Revision: 1.3 $
93             $Name $
94              
95             =cut
96