AI-FANN-Evolving

 view release on metacpan or  search on metacpan

MANIFEST  view on Meta::CPAN

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)

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

=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 );
		}
		

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

		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;

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

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

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 {

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

	}
	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" );

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

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" );
}

 view all matches for this distribution
 view release on metacpan -  search on metacpan