Algorithm-Evolutionary-Fitness
view release on metacpan or search on metacpan
lib/Algorithm/Evolutionary/Fitness/ECC.pm view on Meta::CPAN
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
=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
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
=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
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
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
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
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
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
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.744 second using v1.01-cache-2.11-cpan-65fba6d93b7 )