AI-FANN-Evolving
view release on metacpan - search on metacpan
view release on metacpan or search on metacpan
The MIT License (MIT)
Copyright (c) 2014 Naturalis Biodiversity Center
Permission is hereby granted, free of charge, to any person obtaining a copy of
this software and associated documentation files (the "Software"), to deal in
the Software without restriction, including without limitation the rights to
use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of
the Software, and to permit persons to whom the Software is furnished to do so,
subject to the following conditions:
The above copyright notice and this permission notice shall be included in all
copies or substantial portions of the Software.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS
FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR
COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER
IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
lib/AI/FANN/Evolving.pm
lib/AI/FANN/Evolving/Chromosome.pm
lib/AI/FANN/Evolving/Experiment.pm
lib/AI/FANN/Evolving/Factory.pm
lib/AI/FANN/Evolving/Gene.pm
lib/AI/FANN/Evolving/TrainData.pm
LICENSE
Makefile.PL
MANIFEST This list of files
MYMETA.json
MYMETA.yml
README.md
script/aivolver
t/00-load.t
t/01-run.t
t/02-data.t
t/03-fann-wrapper.t
t/perl-critic.t
t/perlcriticrc
t/pod-coverage.t
t/pod.t
META.yml Module YAML meta-data (added by MakeMaker)
META.json Module JSON meta-data (added by MakeMaker)
{
"abstract" : "artificial neural network that evolves",
"author" : [
"Rutger Vos <rutger.vos@naturalis.nl>"
],
"dynamic_config" : 1,
"generated_by" : "ExtUtils::MakeMaker version 6.8, CPAN::Meta::Converter version 2.132830",
"license" : [
"unknown"
],
"meta-spec" : {
"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
"version" : "2"
},
"name" : "AI-FANN-Evolving",
"no_index" : {
"directory" : [
"t",
"inc"
]
},
"prereqs" : {
"build" : {
"requires" : {
"ExtUtils::MakeMaker" : "0"
}
},
"configure" : {
"requires" : {
"ExtUtils::MakeMaker" : "0"
}
},
"runtime" : {
"requires" : {
"AI::FANN" : "0",
"Algorithm::Genetic::Diploid" : "0"
}
}
},
"release_status" : "stable",
"version" : "0.4"
}
---
abstract: 'artificial neural network that evolves'
author:
- 'Rutger Vos <rutger.vos@naturalis.nl>'
build_requires:
ExtUtils::MakeMaker: 0
configure_requires:
ExtUtils::MakeMaker: 0
dynamic_config: 1
generated_by: 'ExtUtils::MakeMaker version 6.8, CPAN::Meta::Converter version 2.132830'
license: unknown
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: 1.4
name: AI-FANN-Evolving
no_index:
directory:
- t
- inc
requires:
AI::FANN: 0
Algorithm::Genetic::Diploid: 0
version: 0.4
MYMETA.json view on Meta::CPAN
{
"abstract" : "artificial neural network that evolves",
"author" : [
"Rutger Vos <rutger.vos@naturalis.nl>"
],
"dynamic_config" : 0,
"generated_by" : "ExtUtils::MakeMaker version 6.8, CPAN::Meta::Converter version 2.132830",
"license" : [
"unknown"
],
"meta-spec" : {
"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
"version" : "2"
},
"name" : "AI-FANN-Evolving",
"no_index" : {
"directory" : [
"t",
"inc"
]
},
"prereqs" : {
"build" : {
"requires" : {
"ExtUtils::MakeMaker" : "0"
}
},
"configure" : {
"requires" : {
"ExtUtils::MakeMaker" : "0"
}
},
"runtime" : {
"requires" : {
"AI::FANN" : "0",
"Algorithm::Genetic::Diploid" : "0"
}
}
},
"release_status" : "stable",
"version" : "0.4"
}
---
abstract: 'artificial neural network that evolves'
author:
- 'Rutger Vos <rutger.vos@naturalis.nl>'
build_requires:
ExtUtils::MakeMaker: 0
configure_requires:
ExtUtils::MakeMaker: 0
dynamic_config: 0
generated_by: 'ExtUtils::MakeMaker version 6.8, CPAN::Meta::Converter version 2.132830'
license: unknown
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: 1.4
name: AI-FANN-Evolving
no_index:
directory:
- t
- inc
requires:
AI::FANN: 0
Algorithm::Genetic::Diploid: 0
version: 0.4
Makefile.PL view on Meta::CPAN
#!/usr/bin/perl
use strict;
use warnings;
use ExtUtils::MakeMaker;
WriteMakefile(
'NAME' => 'AI::FANN::Evolving',
'ABSTRACT_FROM' => 'lib/AI/FANN/Evolving.pm',
'VERSION_FROM' => 'lib/AI/FANN/Evolving.pm',
'EXE_FILES' => [ 'script/aivolver' ],
'AUTHOR' => 'Rutger Vos <rutger.vos@naturalis.nl>',
'PREREQ_PM' => {
'AI::FANN' => 0,
'Algorithm::Genetic::Diploid' => 0,
},
);
# AI::FANN::Evolving
Framework to evolve optimal neural networks
## Dependencies
Software packages:
* perl
* perl-doc
Perl modules:
* Algorithm::Genetic::Diploid
* AI::FANN
* YAML::Any
* YAML::Syck
Currently, the build status is:
[](https://travis-ci.org/naturalis/ai-fann-evolving)
lib/AI/FANN/Evolving.pm view on Meta::CPAN
package AI::FANN::Evolving;
use strict;
use warnings;
use AI::FANN ':all';
use List::Util 'shuffle';
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'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,
# 'FANN_THRESHOLD' => FANN_THRESHOLD, # can not be used during training
# 'FANN_THRESHOLD_SYMMETRIC' => FANN_THRESHOLD_SYMMETRIC, # can not be used during training
# 'FANN_SIGMOID' => FANN_SIGMOID, # range is between 0 and 1
# 'FANN_SIGMOID_STEPWISE' => FANN_SIGMOID_STEPWISE, # range is between 0 and 1
'FANN_SIGMOID_SYMMETRIC' => FANN_SIGMOID_SYMMETRIC,
'FANN_SIGMOID_SYMMETRIC_STEPWISE' => FANN_SIGMOID_SYMMETRIC_STEPWISE,
# 'FANN_GAUSSIAN' => FANN_GAUSSIAN, # range is between 0 and 1
'FANN_GAUSSIAN_SYMMETRIC' => FANN_GAUSSIAN_SYMMETRIC,
'FANN_GAUSSIAN_STEPWISE' => FANN_GAUSSIAN_STEPWISE,
# 'FANN_ELLIOT' => FANN_ELLIOT, # range is between 0 and 1
'FANN_ELLIOT_SYMMETRIC' => FANN_ELLIOT_SYMMETRIC,
# 'FANN_LINEAR_PIECE' => FANN_LINEAR_PIECE, # range is between 0 and 1
'FANN_LINEAR_PIECE_SYMMETRIC' => FANN_LINEAR_PIECE_SYMMETRIC,
'FANN_SIN_SYMMETRIC' => FANN_SIN_SYMMETRIC,
'FANN_COS_SYMMETRIC' => FANN_COS_SYMMETRIC,
# 'FANN_SIN' => FANN_SIN, # range is between 0 and 1
# 'FANN_COS' => FANN_COS, # range is between 0 and 1
},
'errorfunc' => {
'FANN_ERRORFUNC_LINEAR' => FANN_ERRORFUNC_LINEAR,
'FANN_ERRORFUNC_TANH' => FANN_ERRORFUNC_TANH,
},
'stopfunc' => {
'FANN_STOPFUNC_MSE' => FANN_STOPFUNC_MSE,
# 'FANN_STOPFUNC_BIT' => FANN_STOPFUNC_BIT,
}
);
my %constant;
for my $hashref ( values %enum ) {
while( my ( $k, $v ) = each %{ $hashref } ) {
$constant{$k} = $v;
}
}
my %default = (
'error' => 0.0001,
'epochs' => 5000,
'train_type' => 'ordinary',
'epoch_printfreq' => 100,
'neuron_printfreq' => 0,
'neurons' => 15,
'activation_function' => FANN_SIGMOID_SYMMETRIC,
);
=head1 NAME
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,
);
# copy the AI::FANN properties
$ann->template($self->{'ann'});
return $self;
}
else {
die "Need 'file', 'data' or 'ann' argument!";
}
}
=item template
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;
}
=item recombine
Recombines (exchanges) properties between the two objects at the provided rate, e.g.
$ann1->recombine($ann2,0.5) means that on average half of the object properties are
exchanged between $ann1 and $ann2
=cut
sub recombine {
my ( $self, $other, $rr ) = @_;
# recombine the simple properties
my %scalar_properties = __PACKAGE__->_scalar_properties;
for my $prop ( keys %scalar_properties ) {
if ( rand(1) < $rr ) {
my $vals = $self->$prop;
my $valo = $other->$prop;
$other->$prop($vals);
$self->$prop($valo);
}
}
# copy over the list properties
my %list_properties = __PACKAGE__->_list_properties;
for my $prop ( keys %list_properties ) {
if ( rand(1) < $rr ) {
my @values = $self->$prop;
my @valueo = $other->$prop;
$other->$prop(@values);
$self->$prop(@valueo);
}
}
# copy over the 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;
}
=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 {
$self->$prop( _mutate_enum($handler,$val,$mu) );
}
}
}
}
return $self;
}
sub _mutate_double {
my ( $value, $mu ) = @_;
my $scale = 1 + ( rand( 2 * $mu ) - $mu );
return $value * $scale;
}
sub _mutate_int {
my ( $value, $mu ) = @_;
if ( rand(1) < $mu ) {
my $inc = ( int(rand(2)) * 2 ) - 1;
while( ( $value < 0 ) xor ( ( $value + $inc ) < 0 ) ) {
$inc = ( int(rand(2)) * 2 ) - 1;
}
return $value + $inc;
}
return $value;
}
sub _mutate_enum {
my ( $enum_name, $value, $mu ) = @_;
if ( rand(1) < $mu ) {
my ($newval) = shuffle grep { $_ != $value } values %{ $enum{$enum_name} };
$value = $newval if defined $newval;
}
return $value;
}
sub _list_properties {
(
# cascade_activation_functions => 'activationfunc',
cascade_activation_steepnesses => \&_mutate_double,
)
}
sub _layer_properties {
(
# neuron_activation_function => 'activationfunc',
# neuron_activation_steepness => \&_mutate_double,
)
}
sub _scalar_properties {
(
training_algorithm => 'train',
train_error_function => 'errorfunc',
train_stop_function => 'stopfunc',
learning_rate => \&_mutate_double,
learning_momentum => \&_mutate_double,
quickprop_decay => \&_mutate_double,
quickprop_mu => \&_mutate_double,
rprop_increase_factor => \&_mutate_double,
rprop_decrease_factor => \&_mutate_double,
rprop_delta_min => \&_mutate_double,
rprop_delta_max => \&_mutate_double,
cascade_output_change_fraction => \&_mutate_double,
cascade_candidate_change_fraction => \&_mutate_double,
cascade_output_stagnation_epochs => \&_mutate_int,
cascade_candidate_stagnation_epochs => \&_mutate_int,
cascade_max_out_epochs => \&_mutate_int,
cascade_max_cand_epochs => \&_mutate_int,
cascade_num_candidate_groups => \&_mutate_int,
bit_fail_limit => \&_mutate_double, # 'fann_type',
cascade_weight_multiplier => \&_mutate_double, # 'fann_type',
cascade_candidate_limit => \&_mutate_double, # 'fann_type',
)
}
=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;
my %args = @_;
for ( qw(error epochs train_type epoch_printfreq neuron_printfreq neurons activation_function) ) {
$self->{$_} = $args{$_} // $default{$_};
}
return $self;
}
=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"
# format and reading that back in, then delete the file
my ( $fh, $file ) = tempfile();
close $fh;
$ann->save($file);
$clone->{'ann'} = __PACKAGE__->new_from_file($file);
unlink $file;
# now re-attach the original ANN to the invocant
$self->{'ann'} = $ann;
return $clone;
}
=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,
$self->error,
);
}
}
=item enum_properties
Returns a hash whose keys are names of enums and values the possible states for the
enum
=cut
=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 {
my $self = shift;
my $method = $AUTOLOAD;
$method =~ s/.+://;
# ignore all caps methods
if ( $method !~ /^[A-Z]+$/ ) {
# determine whether to invoke on an object or a package
my $invocant;
if ( ref $self ) {
$invocant = $self->{'ann'};
}
else {
$invocant = 'AI::FANN';
}
# determine whether to pass in arguments
if ( @_ ) {
my $arg = shift;
$arg = $constant{$arg} if exists $constant{$arg};
return $invocant->$method($arg);
}
else {
return $invocant->$method;
}
}
}
1;
lib/AI/FANN/Evolving/Chromosome.pm view on Meta::CPAN
package AI::FANN::Evolving::Chromosome;
use strict;
use AI::FANN::Evolving;
use AI::FANN::Evolving::Experiment;
use Algorithm::Genetic::Diploid;
use base '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);
$chr2->genes($gen2);
}
=item clone
Clones the object
=back
=cut
sub clone {
my $self = shift;
my @genes = $self->genes;
my $self_clone = $self->SUPER::clone;
$self_clone->genes( map { $_->clone } @genes );
return $self_clone;
}
1;
lib/AI/FANN/Evolving/Experiment.pm view on Meta::CPAN
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 '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
Constructor takes named arguments, sets default factory to L<AI::FANN::Evolving::Factory>
=cut
sub new { shift->SUPER::new( 'factory' => AI::FANN::Evolving::Factory->new, @_ ) }
=item workdir
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
that value: 0.
=cut
sub optimum { 0 }
sub _sign {
my ( $obs, $exp ) = @_;
my $fitness = 0;
for my $i ( 0 .. $#{ $obs } ) {
$fitness += ( ( $obs->[$i] > 0 ) xor ( $exp->[$i] > 0 ) );
}
return $fitness / scalar(@{$obs});
}
sub _mse {
my ( $obs, $exp ) = @_;
my $fitness = 0;
for my $i ( 0 .. $#{ $obs } ) {
$fitness += ( ( (1+$obs->[$i]) - (1+$exp->[$i]) ) ** 2 );
}
return $fitness / scalar(@{$obs});
}
=item error_func
Returns a function to compute the error. Given an argument, the following can happen:
'sign' => error is the average number of times observed and expected have different signs
'mse' => error is the mean squared difference between observed and expected
CODE => error function is the provided code reference
=back
=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/Factory.pm view on Meta::CPAN
package AI::FANN::Evolving::Factory;
use strict;
use Algorithm::Genetic::Diploid;
use base 'Algorithm::Genetic::Diploid::Factory';
our $AUTOLOAD;
my %defaults = (
'experiment' => 'AI::FANN::Evolving::Experiment',
'chromosome' => 'AI::FANN::Evolving::Chromosome',
'gene' => 'AI::FANN::Evolving::Gene',
'traindata' => 'AI::FANN::Evolving::TrainData',
);
=head1 NAME
AI::FANN::Evolving::Factory - creator of objects
=head1 METHODS
=over
=item new
Constructor takes named arguments. Key is a short name (e.g. 'traindata'), value is a
fully qualified package name (e.g. L<AI::FANN::TrainData>) from which to instantiate
objects identified by the short name.
=back
=cut
sub new { shift->SUPER::new(%defaults,@_) }
1;
lib/AI/FANN/Evolving/Gene.pm view on Meta::CPAN
package AI::FANN::Evolving::Gene;
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 '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
Constructor is passed named arguments. Instantiates a trained L<AI::FANN::Evolving> ANN
=cut
sub new {
# initialize self up the inheritance tree
my $self = shift->SUPER::new(@_);
# instantiate and train the FANN object
my $traindata = $self->experiment->traindata;
$self->ann( AI::FANN::Evolving->new( 'data' => $traindata ) );
return $self;
}
=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
# the AI was trained on.
my $env = shift;
# 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
my $outfile = $self->experiment->workdir . "/${fitness}.ann";
$self->ann->save($outfile);
return $self->{'fitness'};
}
}
=item fitness
Stores the fitness value after expressing the fitness function
=cut
sub fitness { shift->{'fitness'} }
=item clone
Clones the object
=cut
sub clone {
my $self = shift;
my $ann = delete $self->{'ann'};
my $ann_clone = $ann->clone;
my $self_clone = $self->SUPER::clone;
$self_clone->ann( $ann_clone );
$self->ann( $ann );
return $self_clone;
}
=item mutate
Mutates the ANN by stochastically altering its properties in proportion to
the mutation_rate
=back
=cut
sub mutate {
my $self = shift;
# probably 0.05
my $mu = $self->experiment->mutation_rate;
# make a clone, whose untrained ANN properties are mutated
my $self_clone = $self->clone;
my $ann = AI::FANN::Evolving->new( 'ann' => $self->ann );
$ann->mutate($mu);
$self_clone->ann($ann);
return $self_clone;
}
1;
lib/AI/FANN/Evolving/TrainData.pm view on Meta::CPAN
package AI::FANN::Evolving::TrainData;
use strict;
use List::Util 'shuffle';
use AI::FANN ':all';
use Algorithm::Genetic::Diploid::Base;
use 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
Constructor takes named arguments. By default, ignores column
named ID and considers column named CLASS as classifier.
=cut
sub new {
my $self = shift->SUPER::new(
'ignore' => [ 'ID' ],
'dependent' => [ 'CLASS' ],
'header' => {},
'table' => [],
@_
);
my %args = @_;
$self->read_data($args{'file'}) if $args{'file'};
$self->trim_data if $args{'trim'};
return $self;
}
=item ignore_columns
Getter/setter for column names to ignore in the train data structure.
For example: an identifier columns named 'ID'
=cut
sub ignore_columns {
my $self = shift;
$self->{'ignore'} = \@_ if @_;
return @{ $self->{'ignore'} };
}
=item dependent_columns
Getter/setter for column name(s) of the output value(s).
=cut
sub dependent_columns {
my $self = shift;
$self->{'dependent'} = \@_ if @_;
return @{ $self->{'dependent'} };
}
=item predictor_columns
Getter for column name(s) of input value(s)
=cut
sub predictor_columns {
my $self = shift;
my @others = ( $self->ignore_columns, $self->dependent_columns );
my %skip = map { $_ => 1 } @others;
return grep { ! $skip{$_} } keys %{ $self->{'header'} };
}
=item predictor_data
Getter for rows of input values
=cut
sub predictor_data {
my ( $self, %args ) = @_;
my $i = $args{'row'};
my @cols = $args{'cols'} ? @{ $args{'cols'} } : $self->predictor_columns;
# build hash of indices to keep
my %keep = map { $self->{'header'}->{$_} => 1 } @cols;
# only return a single row
if ( defined $i ) {
my @pred;
for my $j ( 0 .. $#{ $self->{'table'}->[$i] } ) {
push @pred, $self->{'table'}->[$i]->[$j] if $keep{$j};
}
return \@pred;
}
else {
my @preds;
my $max = $self->size - 1;
for my $j ( 0 .. $max ) {
push @preds, $self->predictor_data( 'row' => $j, 'cols' => \@cols);
}
return @preds;
}
}
=item dependent_data
Getter for dependent (classifier) data
=cut
sub dependent_data {
my ( $self, $i ) = @_;
my @dc = map { $self->{'header'}->{$_} } $self->dependent_columns;
if ( defined $i ) {
return [ map { $self->{'table'}->[$i]->[$_] } @dc ];
}
else {
my @dep;
for my $j ( 0 .. $self->size - 1 ) {
push @dep, $self->dependent_data($j);
}
return @dep;
}
}
=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;
}
else {
push @table, \@fields;
}
}
$self->{'header'} = \%header;
$self->{'table'} = \@table;
return $self;
}
=item write_data
Writes to provided output file
=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 };
print $fh "\n";
}
}
=item trim_data
Trims sparse rows with missing values
=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 {
my $self = shift;
my $sample = shift || 0.5;
my $clone1 = $self->clone;
my $clone2 = $self->clone;
my $size = $self->size;
my @sample;
$clone2->{'table'} = \@sample;
while( scalar(@sample) < int( $size * $sample ) ) {
my @shuffled = shuffle( @{ $clone1->{'table'} } );
push @sample, shift @shuffled;
$clone1->{'table'} = \@shuffled;
}
return $clone2, $clone1;
}
=item partition_data
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;
}
=item size
Returns the number of data records
=cut
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);
}
=back
=cut
1;
script/aivolver view on Meta::CPAN
#!/usr/bin/perl
use strict;
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 );
}
# first argument is a config file
if ( -e $ARGV[0] ) {
my $conf = shift;
my $yaml = LoadFile($conf);
$outfile = $yaml->{'outfile'} if defined $yaml->{'outfile'};
$verbosity = $yaml->{'verbosity'} if defined $yaml->{'verbosity'};
$formatter = $yaml->{'formatter'} if defined $yaml->{'formatter'};
%initialize = %{ $yaml->{'initialize'} } if defined $yaml->{'initialize'};
%data = %{ $yaml->{'data'} } if defined $yaml->{'data'};
%experiment = %{ $yaml->{'experiment'} } if defined $yaml->{'experiment'};
%ann = %{ $yaml->{'ann'} } if defined $yaml->{'ann'};
}
# process command line arguments
GetOptions(
'verbose+' => \$verbosity,
'formatter=s' => \$formatter,
'outfile=s' => \$outfile,
'initialize=s' => \%initialize,
'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
=head1 SYNOPSIS
aivolver [<config.yml>] [OPTION]...
try `aivolver --help' or `aivolver --manual' for more information
=head1 OPTIONS AND ARGUMENTS
B<***NO LONGER ACCURATE, CONSULT THE YAML CONFIG FILES***>
=over
=item B<<config.ymlE<gt>>
If the first command line argument is a file location, this will be interpreted as the
location of a configuration file in YAML syntax structured as in this
example: L<https://raw.github.com/naturalis/ai-fann-evolving/master/examples/conf.yml>.
Subsequent command line arguments can then be provided that override the defaults in this
configuration file.
=item B<-h/--help/-?>
Prints help message and exits.
=item B<-m/--manual>
Prints manual page and exits.
=item B<-v/--verbose>
Increments verbosity of the process. Can be used multiple times.
=item B<-o/--outfile <file.annE<gt>>
File name for the fittest ANN file over all generations.
=item B<-d/--data <key=valueE<gt>>
The C<data> argument is used multiple times, each time followed by a key/value pair
that defines the location of one of the data files. The key/value pairs are as follows:
=over
=item B<file=<data.tsvE<gt>>
Defines the location of a file of input data.
=item B<fraction=<numberE<gt>>
Fraction of input data to use for training (versus testing).
=back
=item B<-i/--initialize <key=valueE<gt>>
The C<initialize> argument is used multiple times, each time followed by a key/value
pair that defines one of the initialization settings for the (genetic) structure of the
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>>
The C<experiment> argument is used multiple times, each time followed by a key/value pair
that defines one of the properties of the evolutionary process. The key/value pairs are
as follows:
=over
=item B<crossover_rate=<rateE<gt>>
p of exchange between chromosomes.
=item B<mutation_rate=<rateE<gt>>
p of a trait mutating.
=item B<reproduction_rate=<rateE<gt>>
Proportion of population contributing to next generation.
=item B<ngens=<numberE<gt>>
Number of generations. This should be the longer the better, at least while the
fitness is still improving.
=item B<workdir=<dirE<gt>>
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>
The tables have a header row, with at least the following columns:
=over
=item B<ID>
The C<ID> column contains a unique identifier (a string) for each record in the data set.
=item B<CLASS>
Each C<CLASS> column (multiple are allowed) specifies the classification that should
emerge from one of the output neurons. Often this would be an integer, for example
either C<1> or C<-1> for a binary classification. The number of C<CLASS> columns
determines the number of outputs in the ANN.
=item B<[others]>
All other columns are interpreted as the predictor columns from which the ANN must
derive its capacity for classification. Normally these are continuous values, which
are normalized between all records, e.g. in a range between -1 and 1.
=back
t/00-load.t view on Meta::CPAN
use Test::More tests => 1;
BEGIN {
use_ok('AI::FANN::Evolving');
}
diag("Testing AI::FANN::Evolving $AI::FANN::Evolving::VERSION, Perl $]");
#!/usr/bin/perl
use Test::More 'no_plan';
use strict;
use FindBin qw($Bin);
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 );
# instantiate factory
my $fac = new_ok('AI::FANN::Evolving::Factory');
# prepare data
my $data = AI::FANN::Evolving::TrainData->new(
'file' => "$Bin/../examples/Cochlopetalum.tsv",
'ignore' => [ 'image' ],
'dependent' => [ 'C1', 'C2', 'C3', 'C4', 'C5' ],
);
my ( $test, $train ) = $data->partition_data( 0.5 );
# create the experiment
my $exp = $fac->create_experiment(
'workdir' => tempdir( 'CLEANUP' => 1 ),
'traindata' => $train->to_fann,
'factory' => $fac,
'env' => $test->to_fann,
'mutation_rate' => 0.1,
'ngens' => 2,
);
isa_ok( $exp, 'Algorithm::Genetic::Diploid::Experiment' );
# initialize the experiment
ok( $exp->initialize( 'individual_count' => 2 ), "initialized" );
# run!
my ( $fittest, $fitness ) = $exp->run();
isa_ok( $fittest, 'Algorithm::Genetic::Diploid::Individual' );
t/02-data.t view on Meta::CPAN
use FindBin qw($Bin);
use Test::More 'no_plan';
use AI::FANN::Evolving::TrainData;
use Algorithm::Genetic::Diploid::Logger ':levels';
use Data::Dumper;
# instantiate a data object
my $file = "$Bin/../examples/merged.tsv";
my $data = AI::FANN::Evolving::TrainData->new(
'file' => $file,
'ignore' => [ 'image' ],
'dependent' => [ 'C1', 'C2', 'C3', 'C4' ],
);
ok( $data, "instantiate" );
# partition the data
my ( $d1, $d2 ) = $data->partition_data(0.2);
ok( $data->size == $d1->size + $d2->size, "partition" );
# pack data as FANN struct
ok( $d1->to_fann, "packed d1" );
ok( $d2->to_fann, "packed d2" );
t/03-fann-wrapper.t view on Meta::CPAN
#!/usr/bin/perl
use strict;
use warnings;
use Test::More 'no_plan';
BEGIN {
use_ok('AI::FANN::Evolving');
use_ok('AI::FANN::Evolving::TrainData');
}
##########################################################################################
# create a trivial data object:
my $data = AI::FANN::Evolving::TrainData->new(
'header' => {
'ID' => 0, # simple integer id for the records
's1' => 1, # state 1
's2' => 2, # state 2
'CLASS' => 3, # dependent 'xor' state
},
# this is the xor example from:
# http://search.cpan.org/~salva/AI-FANN-0.10/lib/AI/FANN.pm
'table' => [
[ 1, -1, -1, -1 ],
[ 2, -1, +1, +1 ],
[ 3, +1, -1, +1 ],
[ 4, +1, +1, -1 ],
],
);
ok( $data->size == 4, "instantiate data correctly" );
##########################################################################################
# train the FANN object on trivial data
my $ann = AI::FANN::Evolving->new( 'data' => $data, 'epoch_printfreq' => 0 );
$ann->train($data->to_fann);
# run the network
# this is the xor example from:
# http://search.cpan.org/~salva/AI-FANN-0.10/lib/AI/FANN.pm
my @result = ( -1, +1, +1, -1 );
my @input = ( [ -1, -1 ], [ -1, +1 ], [ +1, -1 ], [ +1, +1 ] );
for my $i ( 0 .. $#input ) {
my $output = $ann->run($input[$i]);
ok( ! ( $result[$i] < 0 xor $output->[0] < 0 ), "observed and expected signs match" );
}
t/perl-critic.t view on Meta::CPAN
use strict;
use warnings;
use File::Spec;
use Test::More;
use English qw'no_match_vars';
if ( not $ENV{'TEST_AUTHOR'} ) {
my $msg = 'env var TEST_AUTHOR not set';
plan( 'skip_all' => $msg );
}
eval { require Test::Perl::Critic; };
if ($EVAL_ERROR) {
my $msg = 'Test::Perl::Critic required to criticise code';
plan( 'skip_all' => $msg );
}
my $rcfile = File::Spec->catfile( 't', 'perlcriticrc' );
Test::Perl::Critic->import( '-profile' => $rcfile );
Test::Perl::Critic::all_critic_ok();
t/perlcriticrc view on Meta::CPAN
[BuiltinFunctions::ProhibitStringyEval]
severity = 1
[TestingAndDebugging::ProhibitNoStrict]
allow = refs
[Subroutines::ProhibitSubroutinePrototypes]
severity = 1
t/pod-coverage.t view on Meta::CPAN
use Test::More;
plan skip_all => 'env var TEST_AUTHOR not set' if not $ENV{'TEST_AUTHOR'};
eval "use Test::Pod::Coverage 1.04";
plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage"
if $@;
all_pod_coverage_ok();
use Test::More;
plan skip_all => 'env var TEST_AUTHOR not set' if not $ENV{'TEST_AUTHOR'};
eval "use Test::Pod 1.14";
plan skip_all => "Test::Pod 1.14 required for testing POD" if $@;
all_pod_files_ok();
view release on metacpan - search on metacpan
( run in 2.317 seconds using v1.00-cache-2.02-grep-82fe00e-cpan-72ae3ad1e6da )