Algorithm-Evolutionary-Fitness
9 results

 view release on metacpan or  search on metacpan

lib/Algorithm/Evolutionary/Fitness/ECC.pm  view on Meta::CPAN 

11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
 
    my $number_of_codewords = 10;
    my $min_distance = 1;
    my $p_peaks = Algorithm::Evolutionary::Fitness::ECC->new( $number_of_codewords, $min_distance );
 
=head1 DESCRIPTION
 
Extracted from article "Effects of scale-free and small-world topologies on binary coded self-adaptive CEA", by Giacobini et al [Ga]. Quoting:
 
"                                                    The ECC problem was presented in
[MW]. We will consider a three-tuple (n, M, d), where n is the length of each codeword
(number of bits), M is the number of codewords, and d is the minimum Hamming
distance between any pair of codewords. Our objective will be to find a code which
has a value for d as large as possible (reflecting greater tolerance to noise and errors),
given previously fixed values for n and M . The problem we have studied is a simplified
version of that in [MW]. In our case we search half of the codewords (M/2) that will
compose the code, and the other half is made up by the complement of the codewords
computed by the algorithm"
 
[Ga] Mario Giacobini, Mike Preuss, Marco Tomassini: Effects of Scale-Free and Small-World Topologies on Binary Coded Self-adaptive CEA. EvoCOP 2006: 86-98.

lib/Algorithm/Evolutionary/Fitness/ECC.pm  view on Meta::CPAN 

83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
 
=cut
 
sub ecc {
    my $self = shift;
    my $string = shift || croak "Can't work with a null string";
    my $cache = $self->{'_cache'};
    if ( $cache->{$string} ) {
        return $cache->{$string};
    }
    my $length = length($string)/$self->{'number_of_codewords'};
    my @codewords = ( $string =~ /.{$length}/gs );
    my $distance;
    for ( my $i = 0; $i <= $#codewords; $i ++ ) {
      for ( my $j = $i+1; $j <= $#codewords; $j ++ ) {
        my $this_distance = hamming( $codewords[$i], $codewords[$j] );
        $distance += 1/(1+$this_distance*$this_distance);
      }
    }
    $cache->{$string} = 1/$distance;
    return $cache->{$string};

lib/Algorithm/Evolutionary/Fitness/Knapsack.pm  view on Meta::CPAN 

81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
my $cache = $self->{'_cache'};
if ( $cache->{$string} ) {
    return $cache->{$string};
}
my $profit=0.0;
my $weight=0.0;
 
my @profits = @{$self->{'profits'}};
my @weights = @{$self->{'weights'}};
 
for (my $i=0 ; $i < length($string); $i++) {   #Compute weight
  my $this_bit=substr ($string, $i, 1);
   
  if ($this_bit == 1)  {
    $profit += $profits[$i];
    $weight += $weights[$i];
  }
}
 
if ($weight > $self->{'capacity'}) { # Apply penalty
  my $penalty = $self->{'rho'} * ($weight - $self->{'capacity'});

lib/Algorithm/Evolutionary/Fitness/MMDP.pm  view on Meta::CPAN 

43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
=cut 
 
sub mmdp {
    my $self = shift;
    my $string = shift;
    my $cache = $self->{'_cache'};
    if ( $cache->{$string} ) {
        return $cache->{$string};
    }
    my $fitness = 0;
    for ( my $i = 0; $i < length($string); $i+= BLOCK_SIZE ) {
        my $block = substr( $string, $i, BLOCK_SIZE );
        my $ones = grep ( /1/, split(//,$block));
        $fitness += $unitation[$ones];
    }
    $cache->{$string} = $fitness;
    return $fitness;
}
 
=head1 Copyright
  

lib/Algorithm/Evolutionary/Fitness/Royal_Road.pm  view on Meta::CPAN 

57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
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};

lib/Algorithm/Evolutionary/Fitness/Trap.pm  view on Meta::CPAN 

84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
sub trap {
    my $self = shift;
    my $string = shift;
    my $cache = $self->{'_cache'};
    if ( $cache->{$string} ) {
        return $cache->{$string};
    }
    my $l = $self->{'l'};
    my $z = $self->{'z'};
    my $total = 0;
    for ( my $i = 0; $i < length( $string); $i+= $l ) {
      my $substr = substr( $string, $i, $l );
      my $key = $substr;
      if ( !$cache->{$substr} ) {
        my $num_ones = 0;
        while ( $substr ) {
          $num_ones += chop( $substr );
        }
        if ( $num_ones <= $z ) {
          $cache->{$key} = $self->{'a'}*($z-$num_ones)/$z;
        } else {

t/01-onemax.t  view on Meta::CPAN 

11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
 
use lib qw( ../../algorithm-evolutionary-utils/lib ../../lib ../lib lib ); #Just in case we are testing it in-place
use Algorithm::Evolutionary::Utils qw(random_bitstring);
 
use_ok( "Algorithm::Evolutionary::Fitness::ONEMAX", "using A::E::Fitness::ONEMAX OK" );
 
my $om = new Algorithm::Evolutionary::Fitness::ONEMAX;
isa_ok( $om,  "Algorithm::Evolutionary::Fitness::ONEMAX" );
 
my $num_bits = 32;
my $indi = random_bitstring( $num_bits, 1) ; # Build random bitstring with length 10
ok( $om->_apply( $indi ) > 0, "Works on indis" );
ok( $om->onemax( $indi->{'_str'})  > 0, "Works on strings" );
my $string = "11111111111";
my $copy = $string;
ok( $om->onemax( $string) == 11, "OK count 1" );
ok( $string == $copy, "String not affected" );
$string = "010111101111110";
ok( $om->onemax( $string ) == 11, "OK count 2" );
$om->reset_evaluations();
ok( $om->evaluations() == 0, "Evaluations reset");

t/0302-knapsack.t  view on Meta::CPAN 

19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
my @profits=(13.76, 8.40465, 7.06637, 14.066, 6.92841, 13.0597, 8.08657, 9.78078, 7.69908, 11.3133, 11.5659, 9.03571, 14.9824, 9.77511, 6.96194, 12.4665, 14.5813, 9.76035, 10.4337, 11.443, 12.8197, 10.4104, 14.1428, 7.15892, 10.8211, 7.30107, 7.86628...
my @weights=(8.75995, 3.40465, 2.06637, 9.06605, 1.92841, 8.05966, 3.08657, 4.78078, 2.69908, 6.31326, 6.56593, 4.03571, 9.98242, 4.77511, 1.96194, 7.46651, 9.58128, 4.76035, 5.4337, 6.44295, 7.8197, 5.41039, 9.14283, 2.15892, 5.82114, 2.30107, 2.866...
 
my $Nmax=100;  #Max. number of elements to choose
my $capacity=286; #Max. Capacity of the knapsack
my $rho=5.0625; #Penalizations coeficient
 
my $knap = new Algorithm::Evolutionary::Fitness::Knapsack( $Nmax, $capacity, $rho, \@profits, \@weights );
isa_ok( $knap,  "Algorithm::Evolutionary::Fitness::Knapsack" );
 
my $indi = random_bitstring $Nmax, 1 ; # Build random bitstring with length 10
ok( $knap->_apply( $indi ) > 0, "Works on indis" );
ok( $knap->knapsack( $indi->{'_str'})  > 0, "Works on strings and caches" );
ok( $knap->cached_evals() == 1, "Cached evals OK");
 
done_testing();

t/0304-royalroad.t  view on Meta::CPAN 

8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
use lib qw( ../../lib ../lib lib ); #Just in case we are testing it in-place
use Algorithm::Evolutionary::Utils qw(random_bitstring);
 
use_ok( "Algorithm::Evolutionary::Fitness::Royal_Road", "using A::E::Fitness::ONEMAX OK" );
 
my $block_size=4;
my $rr = new Algorithm::Evolutionary::Fitness::Royal_Road( $block_size );
isa_ok( $rr,  "Algorithm::Evolutionary::Fitness::Royal_Road" );
 
my $num_bits = 32;
my $indi = random_bitstring $num_bits, 1 ; # Build random bitstring with length 10
$indi->{'_str'} .= "1111"; # makes sure it's not 0
ok( $rr->apply( $indi ) > 0, "Works on indis" );
ok( $rr->royal_road( $indi->{'_str'})  > 0, "Works on strings" );
ok( $rr->cached_evals() == 1, "Cached evals OK");
my $string = "111101111100";
ok( $rr->royal_road( $string) == 4, "OK count 1" );
$string = "1111011111111";
ok( $rr->royal_road( $string ) == 8, "OK count 2" );
 
done_testing();

t/0333-mmdp.t  view on Meta::CPAN 

5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
use Test::More tests => 7;
use warnings;
use strict;
 
use lib qw( ../../lib ../lib lib ); #Just in case we are testing it in-place
 
use_ok( "Algorithm::Evolutionary::Fitness::MMDP", "using Fitness::MMDP OK" );
 
my $units = "000000";
my $mmdp = new  Algorithm::Evolutionary::Fitness::MMDP;
for (my $i = 0; $i < length($units); $i++ ) {
    my $clone = $units;
    substr($clone, $i, 1 ) = "1";
    is(  $mmdp->mmdp( $clone ),
         $Algorithm::Evolutionary::Fitness::MMDP::unitation[$i+1],
         "Unitation $i = ". $Algorithm::Evolutionary::Fitness::MMDP::unitation[$i+1]." OK");
    $units = $clone;
}



( run in 0.582 second using v1.01-cache-2.11-cpan-87723dcf8b7 )