• Your recent searches
AI-FANN-Evolving
7 results

 view release on metacpan or  search on metacpan

lib/AI/FANN/Evolving.pm  view on Meta::CPAN 

6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
use File::Temp 'tempfile';
use AI::FANN::Evolving::Gene;
use AI::FANN::Evolving::Chromosome;
use AI::FANN::Evolving::Experiment;
use AI::FANN::Evolving::Factory;
use Algorithm::Genetic::Diploid;
use base qw'https://metacpan.org/pod/Algorithm::Genetic::Diploid::Base">Algorithm::Genetic::Diploid::Base';
 
our $VERSION = '0.4';
our $AUTOLOAD;
my $log = __PACKAGE__->logger;
 
my %enum = (
        'train' => {
#               'FANN_TRAIN_INCREMENTAL' => FANN_TRAIN_INCREMENTAL, # only want batch training
                'FANN_TRAIN_BATCH'       => FANN_TRAIN_BATCH,
                'FANN_TRAIN_RPROP'       => FANN_TRAIN_RPROP,
                'FANN_TRAIN_QUICKPROP'   => FANN_TRAIN_QUICKPROP,    
        },
        'activationfunc' => {
                'FANN_LINEAR'                     => FANN_LINEAR,

lib/AI/FANN/Evolving.pm  view on Meta::CPAN 

73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
 
AI::FANN::Evolving - artificial neural network that evolves
 
=head1 METHODS
 
=over
 
=item new
 
Constructor requires 'file', or 'data' and 'neurons' arguments. Optionally takes 
'connection_rate' argument for sparse topologies. Returns a wrapper around L<AI::FANN>.
 
=cut
 
sub new {
        my $class = shift;
        my %args  = @_;
        my $self  = {};
        bless $self, $class;
        $self->_init(%args);
         
        # de-serialize from a file
        if ( my $file = $args{'file'} ) {
                $self->{'ann'} = AI::FANN->new_from_file($file);
                $log->debug("instantiating from file $file");
                return $self;
        }
         
        # build new topology from input data
        elsif ( my $data = $args{'data'} ) {
                $log->debug("instantiating from data $data");
                $data = $data->to_fann if $data->isa('AI::FANN::Evolving::TrainData');
                 
                # prepare arguments
                my $neurons = $args{'neurons'} || ( $data->num_inputs + 1 );
                my @sizes = ( 
                        $data->num_inputs, 
                        $neurons,
                        $data->num_outputs
                );
                 
                # build topology
                if ( $args{'connection_rate'} ) {
                        $self->{'ann'} = AI::FANN->new_sparse( $args{'connection_rate'}, @sizes );
                }
                else {
                        $self->{'ann'} = AI::FANN->new_standard( @sizes );
                }
                 
                # finalize the instance
                return $self;
        }
         
        # build new ANN using argument as a template
        elsif ( my $ann = $args{'ann'} ) {
                $log->debug("instantiating from template $ann");
                 
                # copy the wrapper properties
                %{ $self } = %{ $ann };
                 
                # instantiate the network dimensions
                $self->{'ann'} = AI::FANN->new_standard(
                        $ann->num_inputs, 
                        $ann->num_inputs + 1,
                        $ann->num_outputs,
                );

lib/AI/FANN/Evolving.pm  view on Meta::CPAN 

150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
 
Uses the object as a template for the properties of the argument, e.g.
$ann1->template($ann2) applies the properties of $ann1 to $ann2
 
=cut
 
sub template {
        my ( $self, $other ) = @_;
         
        # copy over the simple properties
        $log->debug("copying over simple properties");
        my %scalar_properties = __PACKAGE__->_scalar_properties;
        for my $prop ( keys %scalar_properties ) {
                my $val = $self->$prop;
                $other->$prop($val);
        }
         
        # copy over the list properties
        $log->debug("copying over list properties");
        my %list_properties = __PACKAGE__->_list_properties;
        for my $prop ( keys %list_properties ) {
                my @values = $self->$prop;
                $other->$prop(@values);
        }
         
        # copy over the layer properties
        $log->debug("copying over layer properties");
        my %layer_properties = __PACKAGE__->_layer_properties;
        for my $prop ( keys %layer_properties ) {
                for my $i ( 0 .. $self->num_layers - 1 ) {
                        for my $j ( 0 .. $self->layer_num_neurons($i) - 1 ) {
                                my $val = $self->$prop($i,$j);
                                $other->$prop($i,$j,$val);                   
                        }
                }
        }
        return $self;

lib/AI/FANN/Evolving.pm  view on Meta::CPAN 

233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
}
 
=item mutate
 
Mutates the object by the provided mutation rate
 
=cut
 
sub mutate {
        my ( $self, $mu ) = @_;
        $log->debug("going to mutate at rate $mu");
         
        # mutate the simple properties
        $log->debug("mutating scalar properties");
        my %scalar_properties = __PACKAGE__->_scalar_properties;
        for my $prop ( keys %scalar_properties ) {
                my $handler = $scalar_properties{$prop};
                my $val = $self->$prop;
                if ( ref $handler ) {
                        $self->$prop( $handler->($val,$mu) );
                }
                else {
                        $self->$prop( _mutate_enum($handler,$val,$mu) );
                }
        }       
         
        # mutate the list properties
        $log->debug("mutating list properties");
        my %list_properties = __PACKAGE__->_list_properties;
        for my $prop ( keys %list_properties ) {
                my $handler = $list_properties{$prop};          
                my @values = $self->$prop;
                if ( ref $handler ) {
                        $self->$prop( map { $handler->($_,$mu) } @values );
                }
                else {
                        $self->$prop( map { _mutate_enum($handler,$_,$mu) } @values );
                }               
        }       
         
        # mutate the layer properties
        $log->debug("mutating layer properties");
        my %layer_properties = __PACKAGE__->_layer_properties;
        for my $prop ( keys %layer_properties ) {
                my $handler = $layer_properties{$prop};
                for my $i ( 1 .. $self->num_layers ) {
                        for my $j ( 1 .. $self->layer_num_neurons($i) ) {
                                my $val = $self->$prop($i,$j);
                                if ( ref $handler ) {
                                        $self->$prop( $handler->($val,$mu) );
                                }
                                else {

lib/AI/FANN/Evolving.pm  view on Meta::CPAN 

360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
=item defaults
 
Getter/setter to influence default ANN configuration
 
=cut
 
sub defaults {
        my $self = shift;
        my %args = @_;
        for my $key ( keys %args ) {
                $log->info("setting $key to $args{$key}");
                if ( $key eq 'activation_function' ) {
                        $args{$key} = $constant{$args{$key}};
                }
                $default{$key} = $args{$key};
        }
        return %default;
}
 
sub _init {
        my $self = shift;

lib/AI/FANN/Evolving.pm  view on Meta::CPAN 

386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
}
 
=item clone
 
Clones the object
 
=cut
 
sub clone {
        my $self = shift;
        $log->debug("cloning...");
         
        # we delete the reference here so we can use 
        # Algorithm::Genetic::Diploid::Base's cloning method, which
        # dumps and loads from YAML. This wouldn't work if the 
        # reference is still attached because it cannot be 
        # stringified, being an XS data structure
        my $ann = delete $self->{'ann'};
        my $clone = $self->SUPER::clone;
         
        # clone the ANN by writing it to a temp file in "FANN/FLO"

lib/AI/FANN/Evolving.pm  view on Meta::CPAN 

419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
 
=item train
 
Trains the AI on the provided data object
 
=cut
 
sub train {
        my ( $self, $data ) = @_;
        if ( $self->train_type eq 'cascade' ) {
                $log->debug("cascade training");
         
                # set learning curve
                $self->cascade_activation_functions( $self->activation_function );
                 
                # train
                $self->{'ann'}->cascadetrain_on_data(
                        $data,
                        $self->neurons,
                        $self->neuron_printfreq,
                        $self->error,
                );
        }
        else {
                $log->debug("normal training");
         
                # set learning curves
                $self->hidden_activation_function( $self->activation_function );
                $self->output_activation_function( $self->activation_function );
                 
                # train
                $self->{'ann'}->train_on_data(
                        $data,
                        $self->epochs,
                        $self->epoch_printfreq,

lib/AI/FANN/Evolving.pm  view on Meta::CPAN 

466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
=item error
 
Getter/setter for the error rate. Default is 0.0001
 
=cut
 
sub error {
        my $self = shift;
        if ( @_ ) {
                my $value = shift;
                $log->debug("setting error threshold to $value");
                return $self->{'error'} = $value;
        }
        else {
                $log->debug("getting error threshold");
                return $self->{'error'};
        }
}
 
=item epochs
 
Getter/setter for the number of training epochs, default is 500000
 
=cut
 
sub epochs {
        my $self = shift;
        if ( @_ ) {
                my $value = shift;
                $log->debug("setting training epochs to $value");
                return $self->{'epochs'} = $value;
        }
        else {
                $log->debug("getting training epochs");
                return $self->{'epochs'};
        }
}
 
=item epoch_printfreq
 
Getter/setter for the number of epochs after which progress is printed. default is 1000
 
=cut
 
sub epoch_printfreq {
        my $self = shift;
        if ( @_ ) {
                my $value = shift;
                $log->debug("setting epoch printfreq to $value");
                return $self->{'epoch_printfreq'} = $value;
        }
        else {
                $log->debug("getting epoch printfreq");
                return $self->{'epoch_printfreq'}
        }
}
 
=item neurons
 
Getter/setter for the number of neurons. Default is 15
 
=cut
 
sub neurons {
        my $self = shift;
        if ( @_ ) {
                my $value = shift;
                $log->debug("setting neurons to $value");
                return $self->{'neurons'} = $value;
        }
        else {
                $log->debug("getting neurons");
                return $self->{'neurons'};
        }
}
 
=item neuron_printfreq
 
Getter/setter for the number of cascading neurons after which progress is printed. 
default is 10
 
=cut
 
sub neuron_printfreq {
        my $self = shift;
        if ( @_ ) {
                my $value = shift;
                $log->debug("setting neuron printfreq to $value");
                return $self->{'neuron_printfreq'} = $value;
        }
        else {  
                $log->debug("getting neuron printfreq");
                return $self->{'neuron_printfreq'};
        }
}
 
=item train_type
 
Getter/setter for the training type: 'cascade' or 'ordinary'. Default is ordinary
 
=cut
 
sub train_type {
        my $self = shift;
        if ( @_ ) {
                my $value = lc shift;
                $log->debug("setting train type to $value"); 
                return $self->{'train_type'} = $value;
        }
        else {
                $log->debug("getting train type");
                return $self->{'train_type'};
        }
}
 
=item activation_function
 
Getter/setter for the function that maps inputs to outputs. default is 
FANN_SIGMOID_SYMMETRIC
 
=back
 
=cut
 
sub activation_function {
        my $self = shift;
        if ( @_ ) {
                my $value = shift;
                $log->debug("setting activation function to $value");
                return $self->{'activation_function'} = $value;
        }
        else {
                $log->debug("getting activation function");
                return $self->{'activation_function'};
        }
}
 
# this is here so that we can trap method calls that need to be 
# delegated to the FANN object. at this point we're not even
# going to care whether the FANN object implements these methods:
# if it doesn't we get the normal error for unknown methods, which
# the user then will have to resolve.
sub AUTOLOAD {

lib/AI/FANN/Evolving/Chromosome.pm  view on Meta::CPAN 

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
package AI::FANN::Evolving::Chromosome;
use strict;
use AI::FANN::Evolving;
use AI::FANN::Evolving::Experiment;
use Algorithm::Genetic::Diploid;
use base 'https://metacpan.org/pod/Algorithm::Genetic::Diploid::Chromosome">Algorithm::Genetic::Diploid::Chromosome';
 
my $log = __PACKAGE__->logger;
 
=head1 NAME
 
AI::FANN::Evolving::Chromosome - chromosome of an evolving, diploid AI
 
=head1 METHODS
 
=over
 
=item recombine
 
Recombines properties of the AI during meiosis in proportion to the crossover_rate
 
=cut
 
sub recombine {
        $log->debug("recombining chromosomes");
        # get the genes and columns for the two chromosomes
        my ( $chr1, $chr2 ) = @_;
        my ( $gen1 ) = map { $_->mutate } $chr1->genes;
        my ( $gen2 ) = map { $_->mutate } $chr2->genes;   
        my ( $ann1, $ann2 ) = ( $gen1->ann, $gen2->ann );
        $ann1->recombine($ann2,$chr1->experiment->crossover_rate);
         
        # assign the genes to the chromosomes (this because they are clones
        # so we can't use the old object reference)
        $chr1->genes($gen1);

lib/AI/FANN/Evolving/Experiment.pm  view on Meta::CPAN 

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
package AI::FANN::Evolving::Experiment;
use strict;
use warnings;
use AI::FANN ':all';
use AI::FANN::Evolving;
use File::Temp 'tempfile';
use Algorithm::Genetic::Diploid;
use base 'https://metacpan.org/pod/Algorithm::Genetic::Diploid::Experiment">Algorithm::Genetic::Diploid::Experiment';
 
my $log = __PACKAGE__->logger;
 
=head1 NAME
 
AI::FANN::Evolving::Experiment - an experiment in evolving artificial intelligence
 
=head1 METHODS
 
=over
 
=item new

lib/AI/FANN/Evolving/Experiment.pm  view on Meta::CPAN 

30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
Getter/Setter for the workdir where L<AI::FANN> artificial neural networks will be
written during the experiment. The files will be named after the ANN's error, which 
needs to be minimized.
 
=cut
 
sub workdir {
        my $self = shift;
        if ( @_ ) {
                my $value = shift;
                $log->info("assigning new workdir $value");
                $self->{'workdir'} = $value;
        }
        else {
                $log->debug("retrieving workdir");
        }
        return $self->{'workdir'};
}
 
=item traindata
 
Getter/setter for the L<AI::FANN::TrainData> object.
 
=cut
 
sub traindata {
        my $self = shift;
        if ( @_ ) {
                my $value = shift;
                $log->info("assigning new traindata $value");
                $self->{'traindata'} = $value;
        }
        else {
                $log->debug("retrieving traindata");
        }
        return $self->{'traindata'};
}
 
=item run
 
Runs the experiment!
 
=cut
 
sub run {
        my $self = shift;
        my $log = $self->logger;
         
        $log->info("going to run experiment");
        my @results;
        for my $i ( 1 .. $self->ngens ) {
         
                # modify workdir
                my $wd = $self->{'workdir'};
                $wd =~ s/\d+$/$i/;
                $self->{'workdir'} = $wd;
                mkdir $wd;
                 
                my $optimum = $self->optimum($i);
                 
                $log->debug("optimum at generation $i is $optimum");
                my ( $fittest, $fitness ) = $self->population->turnover($i,$self->env,$optimum);
                push @results, [ $fittest, $fitness ];
        }
        my ( $fittest, $fitness ) = map { @{ $_ } } sort { $a->[1] <=> $b->[1] } @results;
        return $fittest, $fitness;
}
 
=item optimum
 
The optimal fitness is zero error in the ANN's classification. This method returns

lib/AI/FANN/Evolving/Experiment.pm  view on Meta::CPAN 

134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
=cut
 
sub error_func {
        my $self = shift;
         
        # process the argument
        if ( @_ ) {
                my $arg = shift;
                if ( ref $arg eq 'CODE' ) {
                        $self->{'error_func'} = $arg;
                        $log->info("using custom error function");
                }
                elsif ( $arg eq 'sign' ) {
                        $self->{'error_func'} = \&_sign;
                        $log->info("using sign test error function");
                }
                elsif ( $arg eq 'mse' ) {
                        $self->{'error_func'} = \&_mse;
                        $log->info("using MSE error function");
                }
                else {
                        $log->warn("don't understand error func '$arg'");
                }
        }
         
        # map the constructor-supplied argument
        if ( $self->{'error_func'} and $self->{'error_func'} eq 'sign' ) {
                $self->{'error_func'} = \&_sign;
                $log->info("using error function 'sign'");
        }
        elsif ( $self->{'error_func'} and $self->{'error_func'} eq 'mse' ) {
                $self->{'error_func'} = \&_mse;
                $log->info("using error function 'mse'");
        }       
         
        return $self->{'error_func'} || \&_mse;
}
 
1;

lib/AI/FANN/Evolving/Gene.pm  view on Meta::CPAN 

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
use strict;
use warnings;
use List::Util 'shuffle';
use File::Temp 'tempfile';
use Scalar::Util 'refaddr';
use AI::FANN::Evolving;
use Algorithm::Genetic::Diploid::Gene;
use base 'https://metacpan.org/pod/Algorithm::Genetic::Diploid::Gene">Algorithm::Genetic::Diploid::Gene';
use Data::Dumper;
 
my $log = __PACKAGE__->logger;
 
=head1 NAME
 
AI::FANN::Evolving::Gene - gene that codes for an artificial neural network (ANN)
 
=head1 METHODS
 
=over
 
=item new

lib/AI/FANN/Evolving/Gene.pm  view on Meta::CPAN 

39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
=item ann
 
Getter/setter for an L<AI::FANN::Evolving> ANN
 
=cut
 
sub ann {
        my $self = shift;
        if ( @_ ) {
                my $ann = shift;        
                $log->debug("setting ANN $ann");
                return $self->{'ann'} = $ann;
        }
        else {
                $log->debug("getting ANN");
                return $self->{'ann'};
        }
}
 
=item make_function
 
Returns a code reference to the fitness function, which when executed returns a fitness
value and writes the corresponding ANN to file
 
=cut
 
sub make_function {
        my $self = shift;
        my $ann = $self->ann;
        my $error_func = $self->experiment->error_func;
        $log->debug("making fitness function");
         
        # build the fitness function
        return sub {            
         
                # train the AI
                $ann->train( $self->experiment->traindata );
         
                # isa TrainingData object, this is what we need to use
                # to make our prognostications. It is a different data 
                # set (out of sample) than the TrainingData object that

lib/AI/FANN/Evolving/Gene.pm  view on Meta::CPAN 

83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
# this is a number which we try to keep as near to zero
# as possible
my $fitness = 0;
 
# iterate over the list of input/output pairs
for my $i ( 0 .. ( $env->length - 1 ) ) {
        my ( $input, $expected ) = $env->data($i);
        my $observed = $ann->run($input);
         
        use Data::Dumper;
        $log->debug("Observed: ".Dumper($observed));
        $log->debug("Expected: ".Dumper($expected));
         
        # invoke the error_func provided by the experiment
        $fitness += $error_func->($observed,$expected);
}
$fitness /= $env->length;
 
# store result
$self->{'fitness'} = $fitness;
 
# store the AI         

lib/AI/FANN/Evolving/TrainData.pm  view on Meta::CPAN 

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
package AI::FANN::Evolving::TrainData;
use strict;
use List::Util 'shuffle';
use AI::FANN ':all';
use Algorithm::Genetic::Diploid::Base;
use base 'https://metacpan.org/pod/Algorithm::Genetic::Diploid::Base">Algorithm::Genetic::Diploid::Base';
 
our $AUTOLOAD;
my $log = __PACKAGE__->logger;
 
=head1 NAME
 
AI::FANN::Evolving::TrainData - wrapper class for FANN data
 
=head1 METHODS
 
=over
 
=item new

lib/AI/FANN/Evolving/TrainData.pm  view on Meta::CPAN 

129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
}
 
=item read_data
 
Reads provided input file
 
=cut
 
sub read_data {
        my ( $self, $file ) = @_; # file is tab-delimited
        $log->debug("reading data from file $file");
        open my $fh, '<', $file or die "Can't open $file: $!";
        my ( %header, @table );
        while(<$fh>) {
                chomp;
                next if /^\s*$/;
                my @fields = split /\t/, $_;
                if ( not %header ) {
                        my $i = 0;
                        %header = map { $_ => $i++ } @fields;
                }

lib/AI/FANN/Evolving/TrainData.pm  view on Meta::CPAN 

162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
 
=cut
 
sub write_data {
        my ( $self, $file ) = @_;
         
        # use file or STDOUT
        my $fh;
        if ( $file ) {
                open $fh, '>', $file or die "Can't write to $file: $!";
                $log->info("writing data to $file");
        }
        else {
                $fh = \*STDOUT;
                $log->info("writing data to STDOUT");
        }
         
        # print header
        my $h = $self->{'header'};
        print $fh join "\t", sort { $h->{$a} <=> $h->{$b} } keys %{ $h };
        print $fh "\n";
         
        # print rows
        for my $row ( @{ $self->{'table'} } ) {
                print $fh join "\t", @{ $row };

lib/AI/FANN/Evolving/TrainData.pm  view on Meta::CPAN 

195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
=cut
 
sub trim_data {
        my $self = shift;
        my @trimmed;
        ROW: for my $row ( @{ $self->{'table'} } ) {
                next ROW if grep { not defined $_ } @{ $row };
                push @trimmed, $row;
        }
        my $num = $self->{'size'} - scalar @trimmed;
        $log->info("removed $num incomplete rows");
        $self->{'table'} = \@trimmed;
}
 
=item sample_data
 
Sample a fraction of the data
 
=cut
 
sub sample_data {

lib/AI/FANN/Evolving/TrainData.pm  view on Meta::CPAN 

233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
Creates two clones that partition the data according to the provided ratio.
 
=cut
 
sub partition_data {
        my $self   = shift;
        my $sample = shift || 0.5;
        my $clone1 = $self->clone;
        my $clone2 = $self->clone;
        my $remain = 1 - $sample;
        $log->info("going to partition into $sample : $remain");
                 
        # compute number of different dependent patterns and ratios of each
        my @dependents = $self->dependent_data;
        my %seen;
        for my $dep ( @dependents ) {
                my $key = join '/', @{ $dep };
                $seen{$key}++;
        }
         
        # adjust counts to sample size
        for my $key ( keys %seen ) {
                $log->debug("counts: $key => $seen{$key}");
                $seen{$key} = int( $seen{$key} * $sample );
                $log->debug("rescaled: $key => $seen{$key}");
        }
 
        # start the sampling    
        my @dc = map { $self->{'header'}->{$_} } $self->dependent_columns;
        my @new_table; # we will populate this
        my @table = @{ $clone1->{'table'} }; # work on cloned instance
         
        # as long as there is still sampling to do 
        SAMPLE: while( grep { !!$_ } values %seen ) {
                for my $i ( 0 .. $#table ) {
                        my @r = @{ $table[$i] };
                        my $key = join '/', @r[@dc];
                        if ( $seen{$key} ) {
                                my $rand = rand(1);
                                if ( $rand < $sample ) {
                                        push @new_table, \@r;
                                        splice @table, $i, 1;
                                        $seen{$key}--;
                                        $log->debug("still to go for $key: $seen{$key}");
                                        next SAMPLE;
                                }
                        }
                }
        }
        $clone2->{'table'} = \@new_table;
        $clone1->{'table'} = \@table;
        return $clone2, $clone1;
}

lib/AI/FANN/Evolving/TrainData.pm  view on Meta::CPAN 

292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
 
sub size { scalar @{ shift->{'table'} } }
 
=item to_fann
 
Packs data into an L<AI::FANN> TrainData structure
 
=cut
 
sub to_fann {
        $log->debug("encoding data as FANN struct");
        my $self = shift;
        my @cols = @_ ? @_ : $self->predictor_columns;
        my @deps = $self->dependent_data;
        my @pred = $self->predictor_data( 'cols' => \@cols );
        my @interdigitated;
        for my $i ( 0 .. $#deps ) {
                push @interdigitated, $pred[$i], $deps[$i];
        }
        return AI::FANN::TrainData->new(@interdigitated);
}

script/aivolver  view on Meta::CPAN 

3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
use warnings;
use Pod::Usage;
use Getopt::Long;
use YAML::Any 'LoadFile';
use File::Path 'make_path';
use AI::FANN::Evolving;
use AI::FANN::Evolving::TrainData;
use Algorithm::Genetic::Diploid::Logger ':levels';
 
# initialize config variables
my $verbosity = WARN; # log level
my $formatter = 'simple'; # log formatter
my %initialize;       # settings to start the population
my %data;             # train and test data files
my %experiment;       # experiment settings
my %ann;              # ANN settings
my $outfile;
 
# there are no arguments
if ( not @ARGV ) {
        pod2usage( '-verbose' => 0 );
}

script/aivolver  view on Meta::CPAN 

45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
        'data=s'       => \%data,
        'experiment=s' => \%experiment,
        'ann=s'        => \%ann,
        'help|?'       => sub { pod2usage( '-verbose' => 1 ) },
        'manual'       => sub { pod2usage( '-verbose' => 2 ) },
);
 
# configure ANN
AI::FANN::Evolving->defaults(%ann);
 
# configure logger
my $log = Algorithm::Genetic::Diploid::Logger->new;
$log->level( 'level' => $verbosity );
$log->formatter( $formatter );
 
# read input data
my $deps   = join ', ', @{ $data{'dependent'} };
my $ignore = join ', ', @{ $data{'ignore'} };
$log->info("going to read train data $data{file}, ignoring '$ignore', dependent columns are '$deps'");
my $inputdata = AI::FANN::Evolving::TrainData->new(
        'file'      => $data{'file'},
        'dependent' => $data{'dependent'},
        'ignore'    => $data{'ignore'},
);
my ( $traindata, $testdata );
if ( $data{'type'} and lc $data{'type'} eq 'continuous' ) {
        ( $traindata, $testdata ) = $inputdata->sample_data( $data{'fraction'} );
}
else {
        ( $traindata, $testdata ) = $inputdata->partition_data( $data{'fraction'} );
}
 
$log->info("number of training data records: ".$traindata->size);
$log->info("number of test data records: ".$testdata->size);
 
# create first work dir
my $wd  = delete $experiment{'workdir'};
make_path($wd);
$wd .= '/0';
 
# create the experiment
my $exp = AI::FANN::Evolving::Experiment->new(
        'traindata' => $traindata->to_fann,
        'env'       => $testdata->to_fann,
        'workdir'   => $wd,
        %experiment,
);
 
# initialize the experiment
$exp->initialize(%initialize);
 
# run!
my ( $fittest, $fitness ) = $exp->run();
$log->info("*** overall best fitness: $fitness");
my ($gene) = sort { $a->fitness <=> $b->fitness } map { $_->genes } $fittest->chromosomes;
$gene->ann->save($outfile);
 
__END__
 
=pod
 
=head1 NAME
 
aivolver - Evolves optimal artificial neural networks

script/aivolver  view on Meta::CPAN 

167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
evolving population. The key/value pairs are as follows:
 
=over
 
=item B<individual_count=<countE<gt>>
 
Defines the number of individuals in the population.
 
=item B<chromosome_count=<countE<gt>>
 
Defines the number of non-homologous chromosomes (i.e. n for diploid org). Normally
1 chromosome suffices.
 
=item B<gene_count=<countE<gt>>
 
Defines the number of genes per chromosome. Normally 1 gene (i.e. 1 ANN) suffices.
 
=back
 
=item B<-e/--experiment <key=valueE<gt>>

script/aivolver  view on Meta::CPAN 

213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
Output directory.
 
=back
 
=back
 
=head1 DESCRIPTION
 
Artificial neural networks (ANNs) are decision-making machines that develop their
capabilities by training on input data. During this training, the ANN builds a
topology of input neurons, hidden neurons, and output neurons that respond to signals
in ways (and with sensitivities) that are determined by a variety of parameters. How
these parameters will interact to give rise to the final functionality of the ANN is
hard to predict I<a priori>, but can be optimized in a variety of ways.
 
C<aivolver> is a program that does this by evolving parameter settings using a genetic
algorithm that runs for a number of generations determined by C<ngens>. During this
process it writes the intermediate ANNs into the C<workdir> until the best result is
written to the C<outfile>.
 
The genetic algorithm proceeds by simulating a population of C<individual_count> diploid
individuals that each have C<chromosome_count> chromosomes whose C<gene_count> genes
encode the parameters of the ANN. During each generation, each individual is trained
on a sample data set, and the individual's fitness is then calculated by testing its
predictive abilities on an out-of-sample data set. The fittest individuals (whose
fraction of the total is determined by C<reproduction_rate>) are selected for breeding
in proportion to their fitness.
 
Before breeding, each individual undergoes a process of mutation, where a fraction of
the ANN parameters is randomly perturbed. Both the size of the fraction and the
maximum extent of the perturbation is determined by C<mutation_rate>. Subsequently, the
homologous chromosomes recombine (i.e. exchange parameters) at a rate determined by
C<crossover_rate>, which then results in (haploid) gametes. These gametes are fused with
those of other individuals to give rise to the next generation.
 
=head1 TRAINING AND TEST DATA
 
The data that is used for training the ANNs and for subsequently testing their predictive
abilities are provided as tab-separated tables. An example of an input data set is here:
 
L<https://github.com/naturalis/ai-fann-evolving/blob/master/examples/butterbeetles.tsv>

t/01-run.t  view on Meta::CPAN 

5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
use File::Temp 'tempdir';
 
# attempt to load the classes of interest
BEGIN {
        use_ok('AI::FANN::Evolving::Factory');
        use_ok('AI::FANN::Evolving::TrainData');
        use_ok('AI::FANN::Evolving');
        use_ok('Algorithm::Genetic::Diploid::Logger');
}
 
# create and configure logger
my $log = new_ok('Algorithm::Genetic::Diploid::Logger');
$log->level( 'level' => 4 );
$log->formatter(sub{
        my %args = @_;
        if ( $args{'msg'} =~ /fittest at generation (\d+): (.+)/ ) {
                my ( $gen, $fitness ) = ( $1, $2 );
                ok( $fitness, "generation $gen/2, fitness: $fitness" );
        }
        return '';
});
 
# set quieter and quicker to give up
AI::FANN::Evolving->defaults( 'epoch_printfreq' => 0, 'epochs' => 200 );



( run in 0.447 second using v1.01-cache-2.11-cpan-26ccb49234f )