File Coverage

lib/Algorithm/Evolutionary/Individual/Vector.pm
Criterion Covered Total %
statement 30 122 24.5
branch 0 8 0.0
condition 3 24 12.5
subroutine 7 27 25.9
pod 13 13 100.0
total 53 194 27.3


line stmt bran cond sub pod time code
1 3     3   3565 use strict; #-*-cperl-*-
  3         4  
  3         98  
2 3     3   11 use warnings;
  3         3  
  3         121  
3            
4             =head1 NAME
5            
6             Algorithm::Evolutionary::Individual::Vector - Array as an individual for evolutionary computation
7            
8             =head1 SYNOPSIS
9            
10             use Algorithm::Evolutionary::Individual::Vector;
11             my $indi = new Algorithm::Evolutionary::Individual::Vector 10 ; # Build random vector individual with length 10
12             # Each element in the range 0 .. 1
13             my $indi2 = new Algorithm::Evolutionary::Individual::Vector 20, -5, 5; #Same, with range between -5 and 5
14            
15             #Creating a vector step by step. In Perl, there's always more than one way of doing it
16             my $indi3 = new Algorithm::Evolutionary::Individual::Vector;
17             $indi3->set( {length => 20,
18             rangestart => -5,
19             rangeend => 5 } ); #Sets values, but does not build the array
20            
21             $indi3->randomize(); #Creates an array using above parameters
22            
23             print $indi3->Atom( 7 ); #Returns the value of the 7th character
24             $indi3->Atom( 3 ) = '2.35'; #Sets the value
25            
26             $indi3->addAtom( 7.5 ); #Adds a new component to the array at the end
27            
28             my $indi4 = Algorithm::Evolutionary::Individual::Vector->fromString( '3.5,4.5, 0.1, 3.2');
29             #Parses the comma-separated elements of the string and creates a Algorithm::Evolutionary::Individual::Vector from them
30            
31             my $indi5 = $indi4->clone(); #Creates a copy of the individual
32            
33             my @array = qw( 3.5 4.8 3.3 4.2 0.23); #Tie a vector individual
34             tie my @vector, 'Algorithm::Evolutionary::Individual::Vector', @array;
35             print tied( @vector )->asXML();
36            
37             print $indi3->as_string(); #Prints the individual
38             print $indi3->asXML() #Prints it as XML. See L for more info on this
39            
40             =head1 Base Class
41            
42             L
43            
44             =head1 DESCRIPTION
45            
46             Array individual for a EA. Generally used for floating-point
47             arrays. It can be also TIEd so that it can be handled as a normal
48             array.
49            
50             =cut
51            
52             package Algorithm::Evolutionary::Individual::Vector;
53            
54 3     3   10 use Carp;
  3         4  
  3         184  
55 3     3   12 use Exporter;
  3         4  
  3         213  
56            
57             our ($VERSION) = ( '$Revision: 3.2 $ ' =~ / (\d+\.\d+)/ );
58            
59 3     3   13 use base 'Algorithm::Evolutionary::Individual::Base';
  3         5  
  3         1714  
60            
61             =head1 METHODS
62            
63             =head2 new( [$length = 10] [, $start_of_range = 0] [, $end_of_range = 1] )
64            
65             Creates a new random array individual, with fixed initial length, and uniform distribution
66             of values within a range
67            
68             =cut
69            
70             sub new {
71 1     1 1 14 my $class = shift;
72 1         1 my $self;
73 1   50     6 $self->{_length} = shift || 10;
74 1         2 $self->{_array} = ();
75 1   50     7 $self->{_rangestart} = shift || 0;
76 1   50     6 $self->{_rangeend } = shift || 1;
77            
78 1         3 $self->{_fitness} = undef;
79 1         1 bless $self, $class;
80 1         4 $self->randomize();
81 1         2 return $self;
82             }
83            
84             =head2 size()
85            
86             Returns vector size (dimension)
87            
88             =cut
89            
90             sub size {
91 0     0 1 0 my $self = shift;
92 0         0 return $self->{'_length'};
93             }
94            
95             sub TIEARRAY {
96 0     0   0 my $class = shift;
97 0         0 my $self = { _array => \@_,
98             _length => scalar( @_ ),
99             _fitness => undef };
100 0         0 bless $self, $class;
101 0         0 return $self;
102             }
103            
104             =head2 set( $ref_to_hash )
105            
106             Sets values of an individual; takes a hash as input. The array is
107             initialized to a null array, and the start and end range are
108             initialized by default to 0 and 1
109            
110             =cut
111            
112             sub set {
113 0     0 1 0 my $self = shift;
114 0   0     0 my $hash = shift || croak "No params here";
115 0         0 for ( keys %{$hash} ) {
  0         0  
116 0         0 $self->{"_$_"} = $hash->{$_};
117             }
118 0   0     0 $self->{_array} = shift || ();
119 0   0     0 $self->{_rangestart} = $self->{_rangestart} || 0;
120 0   0     0 $self->{_rangeend} = $self->{_rangeend} || 1;
121 0         0 $self->{_fitness} = undef;
122             }
123            
124             =head2 randomize()
125            
126             Assigns random values to the elements
127            
128             =cut
129            
130             sub randomize {
131 1     1 1 2 my $self = shift;
132 1         7 my $range = $self->{_rangeend} - $self->{_rangestart};
133 1         4 for ( my $i = 0; $i < $self->{_length}; $i++ ) {
134 16         10 push @{$self->{_array}}, rand( $range ) + $self->{_rangestart};
  16         65  
135             }
136             }
137            
138             =head2 Atom
139            
140             Gets or sets the value of an atom
141            
142             =cut
143            
144             sub Atom{
145 0     0 1   my $self = shift;
146 0           my $index = shift;
147 0 0         if ( @_ ) {
148 0           $self->{_array}[$index] = shift;
149             } else {
150 0           return $self->{_array}[$index];
151             }
152             }
153            
154             sub FETCH {
155 0     0     my $self = shift;
156 0           return $self->Atom( @_ );
157             }
158            
159             sub STORE {
160 0     0     my $self = shift;
161 0           $self->Atom( @_ );
162             }
163            
164             =head2 addAtom
165            
166             Adds an atom at the end
167            
168             =cut
169            
170             sub addAtom{
171 0     0 1   my $self = shift;
172 0   0       my $atom = shift || croak "No atom to add\n";
173 0           push( @{$self->{_array}}, $atom );
  0            
174 0           $self->{_length}++;
175             }
176            
177             sub PUSH {
178 0     0     my $self = shift;
179 0           push( @{$self->{_array}}, @_ );
  0            
180 0           $self->{_length}++;
181             }
182            
183             sub UNSHIFT {
184 0     0     my $self = shift;
185 0           unshift( @{$self->{_array}}, @_ );
  0            
186 0           $self->{_length}++;
187             }
188            
189             sub POP {
190 0     0     my $self = shift;
191 0           return pop ( @{$self->{_array}} );
  0            
192 0           $self->{_length}--;
193             }
194            
195             sub SHIFT {
196 0     0     my $self = shift;
197 0           return shift @{$self->{_array}} ;
  0            
198 0           $self->{_length}--;
199             }
200            
201             sub SPLICE {
202 0     0     my $self = shift;
203 0           splice( @{$self->{_array}}, shift, shift, @_ );
  0            
204            
205             }
206            
207             sub FETCHSIZE {
208 0     0     my $self = shift;
209 0           return @{$self->{_array}} -1;
  0            
210             }
211            
212             =head2 length()
213            
214             Returns the number of atoms in the individual
215            
216             =cut
217            
218             sub length {
219 0     0 1   my $self = shift;
220 0           return scalar @{$self->{_array}};
  0            
221             }
222            
223             =head2 fromString( $string )
224            
225             Similar to a copy ctor; creates a vector individual from a string composed of
226             stuff separated by a separator
227            
228             =cut
229            
230             sub fromString {
231 0     0 1   my $class = shift;
232 0           my $str = shift;
233 0   0       my $sep = shift || ",";
234 0           my @ary = split( $sep, $str );
235 0           my $self = { _array => \@ary,
236             _fitness => undef };
237 0           bless $self, $class;
238 0           return $self;
239             }
240            
241             =head2 clone()
242            
243             Similar to a copy ctor: creates a new individual from another one
244            
245             =cut
246            
247             sub clone {
248 0   0 0 1   my $indi = shift || croak "Indi to clone missing ";
249 0           my $self = { _fitness => undef,
250             _length => $indi->{_length} };
251 0           $self->{_array} = ();
252 0           push(@{$self->{_array}}, @{$indi->{_array}});
  0            
  0            
253 0           bless $self, ref $indi;
254 0 0         die "Something is wrong " if scalar( @{$self->{_array}} ) > scalar( @{$indi->{_array}} );
  0            
  0            
255 0           return $self;
256             }
257            
258            
259             =head2 asString()
260            
261             Returns a string with chromosome plus fitness. OK, this is a bit confusing
262            
263             =cut
264            
265             sub asString {
266 0     0 1   my $self = shift;
267 0           my $str = $self->as_string();
268 0 0         if ( defined $self->{_fitness} ) {
269 0           $str .=", " . $self->{_fitness};
270             }
271 0           return $str;
272             }
273            
274             =head2 as_string()
275            
276             Returns just the chromosome, not the fitness
277            
278             =cut
279            
280             sub as_string {
281 0     0 1   my $self = shift;
282 0           my $str = join( ", ", @{$self->{_array}});
  0            
283 0           return $str;
284             }
285            
286             =head2 asXML()
287            
288             Prints it as XML. See the L OPEAL manual for details.
289            
290             =cut
291            
292             sub asXML {
293 0     0 1   my $self = shift;
294 0           my $str = $self->SUPER::asXML();
295 0           my $str2 = ">" .join( "", map( "$_ ", @{$self->{_array}} ));
  0            
296 0           $str =~ s/\/>/$str2/e ;
  0            
297 0           return $str."\n";
298             }
299            
300             =head2 Chrom( [$ref_to_array]
301            
302             Sets or gets the array that holds the chromosome. Not very nice, and
303             I would never ever do this in C++
304            
305             =cut
306            
307             sub Chrom {
308 0     0 1   my $self = shift;
309 0 0         if ( defined $_[0] ) {
310 0           $self->{_array} = shift;
311             }
312 0           return $self->{_array}
313             }
314            
315             =head1 Copyright
316            
317             This file is released under the GPL. See the LICENSE file included in this distribution,
318             or go to http://www.fsf.org/licenses/gpl.txt
319            
320             CVS Info: $Date: 2011/11/23 10:59:47 $
321             $Header: /media/Backup/Repos/opeal/opeal/Algorithm-Evolutionary/lib/Algorithm/Evolutionary/Individual/Vector.pm,v 3.2 2011/11/23 10:59:47 jmerelo Exp $
322             $Author: jmerelo $
323             $Revision: 3.2 $
324            
325             =cut