File Coverage

blib/lib/AI/Genetic/Pro/Crossover/Points.pm
Criterion Covered Total %
statement 46 49 93.8
branch 10 12 83.3
condition 3 3 100.0
subroutine 6 6 100.0
pod 0 2 0.0
total 65 72 90.2


line stmt bran cond sub pod time code
1             package AI::Genetic::Pro::Crossover::Points;
2              
3 9     9   59 use warnings;
  9         19  
  9         362  
4 9     9   52 use strict;
  9         21  
  9         367  
5 9     9   53 use List::MoreUtils qw(first_index);
  9         20  
  9         6146  
6             #use Data::Dumper; $Data::Dumper::Sortkeys = 1;
7             #=======================================================================
8 9 50   9 0 115 sub new { bless { points => $_[1] ? $_[1] : 1 }, $_[0]; }
9             #=======================================================================
10             sub run {
11 15     15 0 35 my ($self, $ga) = @_;
12            
13 15         125 my ($chromosomes, $parents, $crossover) = ($ga->chromosomes, $ga->_parents, $ga->crossover);
14 15         96 my ($fitness, $_fitness) = ($ga->fitness, $ga->_fitness);
15 15         29 my @children;
16             #-------------------------------------------------------------------
17 15         80 while(my $elders = shift @$parents){
18 11824         33131 my @elders = unpack 'I*', $elders;
19            
20 11824 50       25650 unless(scalar @elders){
21 0         0 $_fitness->{scalar(@children)} = $fitness->($ga, $chromosomes->[$elders[0]]);
22 0         0 push @children, $chromosomes->[$elders[0]];
23 0         0 next;
24             }
25              
26 11824         17495 my ($min, $max) = (0, $#{$chromosomes->[0]});
  11824         43038  
27 11824 100       43208 if($ga->variable_length){
28 8728         23871 for my $el(@elders){
29 16585     17628   69776 my $idx = first_index { $_ } @{$chromosomes->[$el]};
  17628         41317  
  16585         326829  
30 16585 100       95949 $min = $idx if $idx > $min;
31 16585 100       25107 $max = $#{$chromosomes->[$el]} if $#{$chromosomes->[$el]} < $max;
  397         1480  
  16585         127076  
32             }
33             }
34            
35 11824         16358 my @points;
36 11824 100 100     66286 if($min < $max and $max - $min > 2){
37 11715         15769 my $range = $max - $min;
38 11715         30147 @points = map { $min + int(rand $range) } 1..$self->{points};
  23430         66046  
39             }
40              
41 11824         18838 @elders = map { $chromosomes->[$_]->clone } @elders;
  22494         129786  
42            
43 11824         22105 for my $pt(@points){
44 21130         199776 @elders = sort {
45 23430         95486 splice @$b, 0, $pt, splice( @$a, 0, $pt, @$b[0..$pt-1] );
46 21130         95747 0;
47             } @elders;
48             }
49            
50 11824         94998 my %elders = map { $_ => $fitness->($ga, $elders[$_]) } 0..$#elders;
  22494         95701  
51 11824         47970 my $maximum = (sort { $elders{$a} <=> $elders{$b} } keys %elders)[-1];
  10670         26688  
52 11824         68012 $_fitness->{scalar(@children)} = $elders{$maximum};
53            
54 11824         93873 push @children, $elders[$maximum];
55             }
56             #-------------------------------------------------------------------
57 15         81 return \@children;
58             }
59             #=======================================================================
60             1;