The Perl Toolchain Summit 2025 Needs You: You can help 🙏 Learn more

JMERELO / Algorithm-Evolutionary-0.82.1 / lib / Algorithm / Evolutionary / Op / Eval / MO_Rank.pm 

            

              
1
2
—
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
—
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
—
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
—
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
—
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143

              
use strict;
use warnings;
=head1 NAME
Algorithm::Evolutionary::Op::Eval::MO_Rank - Multiobjective evaluator
                                             based on Pareto rank
=head1 SYNOPSIS
=head1 Base Class
L<Algorithm::Evolutionary::Op::Base>
=head1 DESCRIPTION
After evaluating the population, it's ranked according to the Pareto
fron they're in
=head1 METHODS
=cut
package Algorithm::Evolutionary::Op::Eval::MO_Rank;
use lib qw(../../../..);
our $VERSION =   sprintf "%d.%03d", q$Revision: 3.2 $ =~ /(\d+)\.(\d+)/g; 
use Carp;
use base 'Algorithm::Evolutionary::Op::Base';
use Algorithm::Evolutionary::Utils qw(vector_compare);
# Class-wide constants
our $APPLIESTO =  'ARRAY';
our $ARITY = 1;
=head2 new( $evaluation_function )
Creates an evaluator object
=cut
sub new {
  my $class = shift;
  my $self = {};
  $self->{'_eval'} = shift || croak "No eval function found";
  bless $self, $class;
  return $self;
}
=head2 set( $ref_to_params_hash, $ref_to_code_hash, $ref_to_operators_hash )
Sets the instance variables. Takes a ref-to-hash as input. Not
intended to be used from outside the class. This should go to base,
probably. 
=cut
sub set {
  my $self = shift;
  my $hashref = shift || croak "No params here";
  my $codehash = shift || croak "No code here";
  my $opshash = shift || croak "No ops here";
  for ( keys %$codehash ) {
        $self->{"_$_"} =  eval "sub { $codehash->{$_} } ";
  }
  $self->{_ops} =();
  for ( keys %$opshash ) {
    push @{$self->{_ops}}, 
      Algorithm::Evolutionary::Op::Base::fromXML( $_, $opshash->{$_}->[1], $opshash->{$_}->[0] ) ;
  }
}
=head2 apply( $population )
Evaluates the population, setting its fitness value. Fitness should be
univocal, that is, have a single value per string. 
=cut
sub apply ($) {
    my $self = shift;
    my $pop = shift || croak "No population here";
    croak "Incorrect type ".(ref $pop) if  ref( $pop ) ne $APPLIESTO;
    my $eval = $self->{_eval};
    #Compute vector fitness
    my %fitness_vector_of;
    for my $p (@$pop ) {
      $p->evaluate( $eval );
      $fitness_vector_of{$p->as_string} = $p->Fitness(); #Provisional fitness
    }
    #Compute rank
    my @dominated_by;
    my $i;
    for ( $i = 0; $i < @$pop; $i++ ) {
      for ( my $j = $i+1; $j < @$pop; $j++ ) {
        my $result = 
          vector_compare( $fitness_vector_of{ $pop->[$i]->as_string },
                          $fitness_vector_of{ $pop->[$j]->as_string } );
        $dominated_by[$j]++ if $result == -1;
        $dominated_by[$i]++ if $result == 1;
      }
       
    }
     
    for ( $i = 0; $i < @$pop; $i++ ) {
      $dominated_by[$i]++; # To avoid uninitialized
      $pop->[$i]->Fitness( 1/$dominated_by[$i] );
    }
     
}
=head1 SEE ALSO
=over 4
=item * 
L<Algorithm::Evolutionary::Fitness::Base>
=back
=head1 Copyright
   
  This file is released under the GPL. See the LICENSE file included in this distribution,
  or go to http://www.fsf.org/licenses/gpl.txt
  CVS Info: $Date: 2009/11/23 12:31:16 $ 
  $Header: /media/Backup/Repos/opeal/opeal/Algorithm-Evolutionary/lib/Algorithm/Evolutionary/Op/Eval/MO_Rank.pm,v 3.2 2009/11/23 12:31:16 jmerelo Exp $ 
  $Author: jmerelo $ 
  $Revision: 3.2 $
=cut
"The truth is out there";