File Coverage

blib/lib/AI/Genetic/Pro/Mutation/Bitvector.pm
Criterion Covered Total %
statement 35 49 71.4
branch 16 28 57.1
condition 8 12 66.6
subroutine 4 5 80.0
pod 0 3 0.0
total 63 97 64.9


line stmt bran cond sub pod time code
1             package AI::Genetic::Pro::Mutation::Bitvector;
2              
3 3     3   18 use warnings;
  3         8  
  3         120  
4 3     3   17 use strict;
  3         6  
  3         1798  
5             #use Data::Dumper; $Data::Dumper::Sortkeys = 1;
6             #=======================================================================
7 3     3 0 25 sub new { bless \$_[0], $_[0]; }
8             #=======================================================================
9             sub run {
10 7     7 0 16 my ($self, $ga) = @_;
11              
12             # this is declared here just for speed
13 7         36 my $mutation = $ga->mutation;
14 7         24 my $chromosomes = $ga->chromosomes;
15 7         31 my $_translations = $ga->_translations;
16 7         54 my ($fitness, $_fitness) = ($ga->fitness, $ga->_fitness);
17            
18             # main loop
19 7         23 for my $idx (0..$#$chromosomes){
20 784 100       1436 next if rand() >= $mutation;
21            
22 41 100       132 if($ga->variable_length){
23 19         25 my $rand = rand();
24 19 100 66     146 if($rand < 0.16 and $#{$chromosomes->[$idx]} > 1){
  1 100 66     10  
  4 50 66     25  
    50 66        
    100          
25 1         1 pop @{$chromosomes->[$idx]};
  1         9  
26 3         27 }elsif($rand < 0.32 and $#{$chromosomes->[$idx]} > 1){
27 4         7 shift @{$chromosomes->[$idx]};
  4         26  
28 4         26 }elsif($rand < 0.48 and $#{$chromosomes->[$idx]} < $#$_translations){
29 0 0       0 push @{$chromosomes->[$idx]}, rand > 0.5 ? 0 : 1;
  0         0  
30             }elsif($rand < 0.64 and $#{$chromosomes->[$idx]} < $#$_translations){
31 0 0       0 unshift @{$chromosomes->[$idx]}, rand > 0.5 ? 0 : 1;
  0         0  
32             }elsif($rand < 0.8){
33 9         14 tied(@{$chromosomes->[$idx]})->reverse;
  9         50  
34             }else{
35 5         10 my $id = int rand @{$chromosomes->[$idx]};
  5         27  
36 5 100       45 $chromosomes->[$idx]->[$id] = $chromosomes->[$idx]->[$id] ? 0 : 1;
37             }
38             }else{
39 22         26 my $id = int rand @{$chromosomes->[$idx]};
  22         98  
40 22 100       156 $chromosomes->[$idx]->[$id] = $chromosomes->[$idx]->[$id] ? 0 : 1;
41             }
42             # we need to change fitness
43 41         144 $_fitness->{$idx} = $fitness->($ga, $chromosomes->[$idx]);
44             }
45            
46 7         52 return 1;
47             }
48             #=======================================================================
49             # too slow; mutation is too dangerous in this solution
50             sub run0 {
51 0     0 0   my ($self, $ga) = @_;
52              
53 0           my $mutation = $ga->mutation; # this is declared here just for speed
54 0           foreach my $chromosome (@{$ga->{chromosomes}}){
  0            
55 0 0         if(rand() < $mutation){ tied(@$chromosome)->reverse; }
  0            
56             else{
57 0           for(0..$#$chromosome){
58 0 0         next if rand > $mutation;
59 0 0         $chromosome->[$_] = $chromosome->[$_] ? 0 : 1;
60             }
61             }
62             }
63            
64 0           return 1;
65             }
66             #=======================================================================
67             1;