line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
1
|
|
|
1
|
|
19651
|
use strict; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
47
|
|
2
|
1
|
|
|
1
|
|
6
|
use warnings; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
71
|
|
3
|
|
|
|
|
|
|
|
4
|
|
|
|
|
|
|
=head1 NAME |
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
Algorithm::Evolutionary::Op::Quad_Crossover_Diff - Uniform crossover, but interchanges only those atoms that are different |
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
=head1 SYNOPSIS |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
my $xmlStr3=<
|
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
#Max is 2, anyways |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
EOC |
17
|
|
|
|
|
|
|
my $ref3 = XMLin($xmlStr3); |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
my $op3 = Algorithm::Evolutionary::Op::Base->fromXML( $ref3 ); |
20
|
|
|
|
|
|
|
print $op3->asXML(), "\n"; |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
my $indi = new Algorithm::Evolutionary::Individual::BitString 10; |
23
|
|
|
|
|
|
|
my $indi2 = $indi->clone(); |
24
|
|
|
|
|
|
|
my $indi3 = $indi->clone(); #Operands are modified, so better to clone them |
25
|
|
|
|
|
|
|
$op3->apply( $indi2, $indi3 ); |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
my $op4 = new Algorithm::Evolutionary::Op::Quad_Crossover_Diff 1; #Quad_Crossover_Diff with 1 crossover points |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
=head1 Base Class |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
L |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
=head1 DESCRIPTION |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
Crossover operator for a GA, takes args by reference and issues two |
36
|
|
|
|
|
|
|
children from two parents |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
=head1 METHODS |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
=cut |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
package Algorithm::Evolutionary::Op::Quad_Crossover_Diff; |
43
|
|
|
|
|
|
|
|
44
|
1
|
|
|
1
|
|
7
|
use lib qw( ../../.. ); |
|
1
|
|
|
|
|
7
|
|
|
1
|
|
|
|
|
7
|
|
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
our $VERSION = sprintf "%d.1%02d", q$Revision: 1.2 $ =~ /(\d+)\.(\d+)/g; # Hack for avoiding version mismatch |
47
|
|
|
|
|
|
|
|
48
|
1
|
|
|
1
|
|
217
|
use Carp; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
111
|
|
49
|
|
|
|
|
|
|
|
50
|
1
|
|
|
1
|
|
6
|
use base 'Algorithm::Evolutionary::Op::Crossover'; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
488
|
|
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
#Class-wide constants |
53
|
|
|
|
|
|
|
our $APPLIESTO = 'Algorithm::Evolutionary::Individual::String'; |
54
|
|
|
|
|
|
|
our $ARITY = 2; |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
=head2 apply( $parent_1, $parent_2 ) |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
Same as L, but changes |
59
|
|
|
|
|
|
|
parents, does not return anything; that is, $parent_1 and $parent_2 |
60
|
|
|
|
|
|
|
interchange genetic material. |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
=cut |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
sub apply ($$){ |
65
|
|
|
|
|
|
|
my $self = shift; |
66
|
|
|
|
|
|
|
my $victim = shift || croak "No victim here!"; |
67
|
|
|
|
|
|
|
my $victim2 = shift || croak "No victim here!"; |
68
|
|
|
|
|
|
|
# croak "Incorrect type ".(ref $victim) if !$self->check($victim); |
69
|
|
|
|
|
|
|
# croak "Incorrect type ".(ref $victim2) if !$self->check($victim2); |
70
|
|
|
|
|
|
|
my $minlen = ( length( $victim->{_str} ) > length( $victim2->{_str} ) )? |
71
|
|
|
|
|
|
|
length( $victim2->{_str} ): length( $victim->{_str} ); |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
my @diffs; |
74
|
|
|
|
|
|
|
for ( my $i = 0; $i < $minlen; $i ++ ) { |
75
|
|
|
|
|
|
|
if ( substr( $victim2->{_str}, $i, 1 ) ne substr( $victim->{_str}, $i, 1 ) ) { |
76
|
|
|
|
|
|
|
push @diffs, $i; |
77
|
|
|
|
|
|
|
} |
78
|
|
|
|
|
|
|
} |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
for ( my $i = 0; $i < $self->{_numPoints}; $i ++ ) { |
81
|
|
|
|
|
|
|
if ( @diffs ) { |
82
|
|
|
|
|
|
|
my $diff = splice( @diffs, rand(@diffs), 1 ); |
83
|
|
|
|
|
|
|
my $char = substr($victim->{'_str'},$diff,1); |
84
|
|
|
|
|
|
|
substr( $victim->{_str}, $diff, 1 ) = substr( $victim2->{_str}, $diff, 1 ); |
85
|
|
|
|
|
|
|
substr( $victim2->{_str}, $diff, 1 ) = $char; |
86
|
|
|
|
|
|
|
} else { |
87
|
|
|
|
|
|
|
last; |
88
|
|
|
|
|
|
|
} |
89
|
|
|
|
|
|
|
} |
90
|
|
|
|
|
|
|
# print "Puntos: $pt1, $range \n"; |
91
|
|
|
|
|
|
|
$victim->Fitness( undef ); |
92
|
|
|
|
|
|
|
$victim2->Fitness( undef ); |
93
|
|
|
|
|
|
|
return undef; #As a warning that you should not expect anything |
94
|
|
|
|
|
|
|
} |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
=head1 Copyright |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
This file is released under the GPL. See the LICENSE file included in this distribution, |
99
|
|
|
|
|
|
|
or go to http://www.fsf.org/licenses/gpl.txt |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
CVS Info: $Date: 2010/12/08 17:34:22 $ |
102
|
|
|
|
|
|
|
$Header: /media/Backup/Repos/opeal/opeal/Algorithm-Evolutionary/lib/Algorithm/Evolutionary/Op/Quad_Crossover_Diff.pm,v 1.2 2010/12/08 17:34:22 jmerelo Exp $ |
103
|
|
|
|
|
|
|
$Author: jmerelo $ |
104
|
|
|
|
|
|
|
$Revision: 1.2 $ |
105
|
|
|
|
|
|
|
$Name $ |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
=cut |