File Coverage

blib/lib/AI/Genetic/Pro/Mutation/Rangevector.pm
Criterion Covered Total %
statement 42 69 60.8
branch 9 22 40.9
condition 7 21 33.3
subroutine 7 8 87.5
pod 0 3 0.0
total 65 123 52.8


line stmt bran cond sub pod time code
1             package AI::Genetic::Pro::Mutation::Rangevector;
2              
3 3     3   20 use warnings;
  3         7  
  3         126  
4 3     3   18 use strict;
  3         6  
  3         140  
5 3     3   23 use List::MoreUtils qw(first_index);
  3         7  
  3         238  
6 3     3   3181 use Math::Random qw(random_uniform_integer);
  3         15410  
  3         2966  
7             #use Data::Dumper; $Data::Dumper::Sortkeys = 1;
8             #=======================================================================
9 3     3 0 35 sub new { bless \$_[0], $_[0]; }
10             #=======================================================================
11             sub run {
12 4     4 0 10 my ($self, $ga) = @_;
13              
14             # this is declared here just for speed
15 4         24 my $mutation = $ga->mutation;
16 4         22 my $chromosomes = $ga->chromosomes;
17 4         23 my $_translations = $ga->_translations;
18 4         34 my ($fitness, $_fitness) = ($ga->fitness, $ga->_fitness);
19              
20             # main loop
21 4         22 for my $idx (0..$#$chromosomes){
22 5520 100       22895 next if rand() >= $mutation;
23              
24 277 100       895 if($ga->variable_length){
25 216         290 my $rand = rand();
26              
27 216     217   705 my $min = first_index { $_ } @{$chromosomes->[$idx]};
  217         407  
  216         2992  
28 216         928 my $range = $#{$chromosomes->[$idx]} - $min + 1;
  216         743  
29            
30 216 100 66     1072 if($rand < 0.4 and $range > 2){
  69 50 66     229  
31 95 100 100     399 if($rand < 0.2 and $ga->variable_length > 1){ $chromosomes->[$idx]->[$min] = 0; }
  26         110  
32 69         76 else{ pop @{$chromosomes->[$idx]}; }
  69         255  
33             }elsif($rand < 0.8 and $range < scalar @{$_translations}){
34 0 0 0     0 if($rand < 0.6 and $ga->variable_length > 1 and not $chromosomes->[$idx]->[0]){
  0 0 0     0  
35 0         0 $chromosomes->[$idx]->[ $min - 1 ] = random_uniform_integer(1, @{$_translations->[ $min - 1 ]}[1..2]);
  0         0  
36             }elsif(exists $_translations->[scalar @{$chromosomes->[$idx]}]){
37 0         0 push @{$chromosomes->[$idx]}, random_uniform_integer(1, @{$_translations->[scalar @{$chromosomes->[$idx]}]}[1..2]);
  0         0  
  0         0  
  0         0  
38             }
39             }else{
40 121         271 my $id = $min + int rand($range - 1);
41 121         158 $chromosomes->[$idx]->[$id] = random_uniform_integer(1, @{$_translations->[$id]}[1..2]);
  121         429  
42             }
43             }else{
44 61         81 my $id = int rand @{$chromosomes->[$idx]};
  61         300  
45 61         108 $chromosomes->[$idx]->[$id] = random_uniform_integer(1, @{$_translations->[$id]}[1..2]);
  61         198  
46             }
47            
48             # we need to change fitness
49 277         3218 $_fitness->{$idx} = $fitness->($ga, $chromosomes->[$idx]);
50             }
51            
52 4         36 return 1;
53             }
54             #=======================================================================
55             sub run0 {
56 0     0 0   my ($self, $ga) = @_;
57              
58             # this is declared here just for speed
59 0           my $mutation = $ga->mutation;
60            
61             # main loop
62 0           foreach my $chromosome (@{$ga->{chromosomes}}){
  0            
63 0 0         next if rand() <= $mutation;
64            
65 0 0         if($ga->variable_length){
66 0           my $rand = rand();
67 0 0 0       if($rand < 0.33 and $#$chromosome > 1){
  0 0 0        
68 0           pop @$chromosome;
69             }elsif($rand < 0.66 and $#$chromosome < $#{$ga->_translations}){
70 0           push @$chromosome, random_uniform_integer(1, @{$ga->_translations->[scalar @$chromosome]});
  0            
71             }else{
72 0           my $idx = int rand @$chromosome;
73 0           $chromosome->[$idx] = random_uniform_integer(1, @{$ga->_translations->[$idx]});
  0            
74             }
75             }else{
76 0           my $idx = int rand @$chromosome;
77 0           $chromosome->[$idx] = random_uniform_integer(1, @{$ga->_translations->[$idx]});
  0            
78             }
79             }
80            
81 0           return 1;
82             }
83             #=======================================================================
84             1;