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   5 use strict; #-*-cperl-*-
  1         1  
  1         25  
2 1     1   4 use warnings;
  1         2  
  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             Attempts all possible mutations in order, until a "novelty" individual
24             is found. Generated individuals are checked against the population
25             hash, and discarded if they are already in the population.
26              
27             =head1 METHODS
28              
29             =cut
30              
31             package Algorithm::Evolutionary::Op::Replace_Different;
32              
33             our $VERSION = sprintf "%d.%d", q$Revision: 1.1 $ =~ /(\d+)\.(\d+)/g;
34              
35 1     1   137 use Carp;
  1         7  
  1         44  
36              
37 1     1   5 use base 'Algorithm::Evolutionary::Op::Base';
  1         1  
  1         58  
38              
39             #Class-wide constants
40             our $ARITY = 1;
41              
42             =head2 apply( $population, $chromosome_list )
43              
44             Eliminates the worst individuals in the population, replacing them by the list of new chromosomes. The population must be evaluated, but there's no need to have it sorted in advance.
45              
46             =cut
47              
48             sub apply ($;$){
49             my $self = shift;
50             my $population = shift || croak "No population here!";
51             my $chromosome_list = shift || croak "No new population here!";
52            
53             #Sort
54             my @sorted_population = sort { $b->Fitness() <=> $a->Fitness(); }
55             @$population ;
56              
57             my %population_hash;
58             map( $population_hash{$_->{'_str'}} = 1, @sorted_population );
59              
60             my @non_repeated = grep( !$population_hash{$_->{'_str'}}, @$chromosome_list );
61             my $to_eliminate = scalar @non_repeated;
62             if ( $to_eliminate > 0 ) {
63             # print "Eliminating $to_eliminate\n";
64             splice ( @sorted_population, -$to_eliminate );
65             push @sorted_population, @non_repeated;
66             }
67             return \@sorted_population;
68              
69             }
70              
71             =head1 SEE ALSO
72              
73             L, where the
74             replacement policy is one of the parameters
75              
76             It can also be used in L for
77             insertion of new individuals asynchronously.
78              
79             =head1 Copyright
80            
81             This file is released under the GPL. See the LICENSE file included in this distribution,
82             or go to http://www.fsf.org/licenses/gpl.txt
83              
84             CVS Info: $Date: 2011/02/21 16:53:20 $
85             $Header: /cvsroot/opeal/Algorithm-Evolutionary/lib/Algorithm/Evolutionary/Op/Replace_Different.pm,v 1.1 2011/02/21 16:53:20 jmerelo Exp $
86             $Author: jmerelo $
87             $Revision: 1.1 $
88             $Name $
89              
90             =cut
91