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; |