From Code to Community: Sponsoring The Perl and Raku Conference 2025 Learn more

JMERELO / Algorithm-Evolutionary-0.82.1 / lib / Algorithm / Evolutionary / Fitness / Royal_Road.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

              
use strict;
use warnings;
use lib qw( ../../../../lib );
=head1 NAME
Algorithm::Evolutionary::Fitness::Royal_Road - Mitchell's Royal Road function
=head1 SYNOPSIS
    my $block_size = 4;
    my $rr = Algorithm::Evolutionary::Fitness::Royal_Road->new( $block_size ); 
=head1 DESCRIPTION
Royal Road function, adds block_size to fitness only when the block is complete
=head1 METHODS
=cut
package Algorithm::Evolutionary::Fitness::Royal_Road;
our ($VERSION) = ( '$Revision: 3.1 $ ' =~ / (\d+\.\d+)/ ) ;
use base qw(Algorithm::Evolutionary::Fitness::String);
=head2 new( $block_size )
Creates a new instance of the problem, with the said block size. 
=cut 
sub new {
  my $class = shift;
  my ( $block_size ) = @_;
  my $self = $class->SUPER::new();
  $self->{'_block_size'} = $block_size;
  $self->initialize();
  return $self;
}
sub _really_apply {
    my $self = shift;
    return  $self->royal_road( @_ );
}
=head2 royal_road( $string )
Computes the royal road function with given block size. Results are
cached by default.
=cut
sub royal_road {
    my $self = shift;
    my $string = shift;
    my $cache = $self->{'_cache'};
     
    if ( $cache->{$string} ) {
        return $cache->{$string};
    }
    my $fitness = 0;
    my $block_size = $self->{'_block_size'};
    for ( my $i = 0; $i < length( $string ) / $block_size; $i++ ) {
        my $block = 0;
        if ( length( substr( $string, $i*$block_size, $block_size )) == $block_size ) {
            $block=1;
            for ( my $j = 0; $j < $block_size; $j++ ) {
                $block &= substr( $string, $i*$block_size+$j, 1 );
            }
        }
        ( $fitness += $block_size ) if $block;
    }
    $cache->{$string} = $fitness;
    return $cache->{$string};
}
=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/07/28 11:30:56 $ 
  $Header: /media/Backup/Repos/opeal/opeal/Algorithm-Evolutionary/lib/Algorithm/Evolutionary/Fitness/Royal_Road.pm,v 3.1 2009/07/28 11:30:56 jmerelo Exp $ 
  $Author: jmerelo $ 
  $Revision: 3.1 $
  $Name $
=cut
"What???";