AI-FANN
view release on metacpan or search on metacpan
Makefile.PL view on Meta::CPAN
ABSTRACT_FROM => 'lib/AI/FANN.pm',
AUTHOR => 'Salvador Fandiño <sfandino@yahoo.com>',
LIBS => ["${fann_lib}-ldoublefann"],
DEFINE => '',
INC => "${fann_inc}-I.",
OBJECT => '$(BASEEXT)$(OBJ_EXT) morefann$(OBJ_EXT)',
#OPTIMIZE => '-g -O0',
depend => { '$(BASEEXT).c' => 'constants.h accessors.xsh' }
);
sub MY::postamble {
return <<MAKE_FRAG
constants.h: genconstants
\t\$(PERL) genconstants > constants.h
accessors.xsh: genaccessors
\t\$(PERL) genaccessors > accessors.xsh
MAKE_FRAG
genaccessors view on Meta::CPAN
#!/usr/bin/perl
use strict;
use warnings;
$| = 1;
my %struct = ( 'AI::FANN' => 'struct fann *',
'AI::FANN::TrainData' => 'struct fann_train_data *' );
sub accessor {
my ($name, $type, $getter, $setter, @ixs) = @_;
my ($package, $method) = $name =~ /^(?:(.*)::)?(.*)$/
or die "wrong accessor name $name";
$package = $package ? "AI::FANN::$package" : 'AI::FANN';
my $struct = $struct{$package}
or die "wrong package name $package";
push @ixs, 'value' unless grep /^value$/, @ixs;
lib/AI/FANN.pm view on Meta::CPAN
our %EXPORT_TAGS = ( 'all' => [ @constants ] );
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
require constant;
for my $constant (@constants) {
constant->import($constant, $constant);
}
}
sub num_neurons {
@_ == 1 or croak "Usage: AI::FANN::get_neurons(self)";
my $self = shift;
if (wantarray) {
map { $self->layer_num_neurons($_) } (0 .. $self->num_layers - 1);
}
else {
$self->total_neurons;
}
}
exit 0;
}
# Scan for possible replacement candidates
my(%replace, %need, %hints, %warnings, %depends);
my $replace = 0;
my($hint, $define, $function);
sub find_api
{
my $code = shift;
$code =~ s{
/ (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]*)
| "[^"\\]*(?:\\.[^"\\]*)*"
| '[^'\\]*(?:\\.[^'\\]*)*' }{}egsx;
grep { exists $API{$_} } $code =~ /(\w+)/mg;
}
while (<DATA>) {
else {
my @new = grep { -f } glob $_
or warn "'$_' does not exist.\n";
push @files, grep { !$seen{$_}++ } @new;
}
}
}
else {
eval {
require File::Find;
File::Find::find(sub {
$File::Find::name =~ /($srcext)$/i
and push @files, $File::Find::name;
}, '.');
};
if ($@) {
@files = map { glob "*$_" } @srcext;
}
}
if (!@ARGV || $opt{filter}) {
else {
info("Looks good");
}
}
close PATCH if $patch_opened;
exit 0;
sub try_use { eval "use @_;"; return $@ eq '' }
sub mydiff
{
local *F = shift;
my($file, $str) = @_;
my $diff;
if (exists $opt{diff}) {
$diff = run_diff($opt{diff}, $file, $str);
}
if (!defined $diff and try_use('Text::Diff')) {
}
if (!defined $diff) {
error("Cannot generate a diff. Please install Text::Diff or use --copy.");
return;
}
print F $diff;
}
sub run_diff
{
my($prog, $file, $str) = @_;
my $tmp = 'dppptemp';
my $suf = 'aaa';
my $diff = '';
local *F;
while (-e "$tmp.$suf") { $suf++ }
$tmp = "$tmp.$suf";
unlink $tmp;
}
else {
error("Cannot open '$tmp' for writing: $!");
}
return undef;
}
sub rec_depend
{
my($func, $seen) = @_;
return () unless exists $depends{$func};
$seen = {%{$seen||{}}};
return () if $seen->{$func}++;
my %s;
grep !$s{$_}++, map { ($_, rec_depend($_, $seen)) } @{$depends{$func}};
}
sub parse_version
{
my $ver = shift;
if ($ver =~ /^(\d+)\.(\d+)\.(\d+)$/) {
return ($1, $2, $3);
}
elsif ($ver !~ /^\d+\.[\d_]+$/) {
die "cannot parse version '$ver'\n";
}
if ($r < 5 || ($r == 5 && $v < 6)) {
if ($s % 10) {
die "cannot parse version '$ver'\n";
}
}
return ($r, $v, $s);
}
sub format_version
{
my $ver = shift;
$ver =~ s/$/000000/;
my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/;
$v = int $v;
$s = int $s;
if ($r < 5 || ($r == 5 && $v < 6)) {
$ver = sprintf "%d.%03d", $r, $v;
$s > 0 and $ver .= sprintf "_%02d", $s;
return $ver;
}
return sprintf "%d.%d.%d", $r, $v, $s;
}
sub info
{
$opt{quiet} and return;
print @_, "\n";
}
sub diag
{
$opt{quiet} and return;
$opt{diag} and print @_, "\n";
}
sub warning
{
$opt{quiet} and return;
print "*** ", @_, "\n";
}
sub error
{
print "*** ERROR: ", @_, "\n";
}
my %given_hints;
my %given_warnings;
sub hint
{
$opt{quiet} and return;
my $func = shift;
my $rv = 0;
if (exists $warnings{$func} && !$given_warnings{$func}++) {
my $warn = $warnings{$func};
$warn =~ s!^!*** !mg;
print "*** WARNING: $func\n", $warn;
$rv++;
}
if ($opt{hints} && exists $hints{$func} && !$given_hints{$func}++) {
my $hint = $hints{$func};
$hint =~ s/^/ /mg;
print " --- hint for $func ---\n", $hint;
}
$rv;
}
sub usage
{
my($usage) = do { local(@ARGV,$/)=($0); <> } =~ /^=head\d$HS+SYNOPSIS\s*^(.*?)\s*^=/ms;
my %M = ( 'I' => '*' );
$usage =~ s/^\s*perl\s+\S+/$^X $0/;
$usage =~ s/([A-Z])<([^>]+)>/$M{$1}$2$M{$1}/g;
print <<ENDUSAGE;
Usage: $usage
See perldoc $0 for details.
ENDUSAGE
exit 2;
}
sub strip
{
my $self = do { local(@ARGV,$/)=($0); <> };
my($copy) = $self =~ /^=head\d\s+COPYRIGHT\s*^(.*?)^=\w+/ms;
$copy =~ s/^(?=\S+)/ /gms;
$self =~ s/^$HS+Do NOT edit.*?(?=^-)/$copy/ms;
$self =~ s/^SKIP.*(?=^__DATA__)/SKIP
if (\@ARGV && \$ARGV[0] eq '--unstrip') {
eval { require Devel::PPPort };
\$@ and die "Cannot require Devel::PPPort, please install.\\n";
if (\$Devel::PPPort::VERSION < $VERSION) {
/* Replace: 1 */
# define PL_ppaddr ppaddr
# define PL_no_modify no_modify
/* Replace: 0 */
#endif
#if (PERL_BCDVERSION <= 0x5004005)
/* Replace: 1 */
# define PL_DBsignal DBsignal
# define PL_DBsingle DBsingle
# define PL_DBsub DBsub
# define PL_DBtrace DBtrace
# define PL_Sv Sv
# define PL_compiling compiling
# define PL_copline copline
# define PL_curcop curcop
# define PL_curstash curstash
# define PL_debstash debstash
# define PL_defgv defgv
# define PL_diehook diehook
# define PL_dirty dirty
samples/ox.pl view on Meta::CPAN
use strict;
use GD;
use AI::FANN qw(:all);
my $num = 500;
my $size = 16;
$| = 1;
sub draw_o {
my ($im, $color) = @_;
my $r = int (0.2 + rand(0.25 * $size));
my $x0 = $r + int rand($size - 2 * $r);
my $y0 = $r + int rand($size - 2 * $r);
$im->arc($x0, $y0, $r, $r, 0, 360, $color);
return 2*$r/$size
}
sub draw_x {
my ($im, $color) = @_;
my $r = int (0.2 + rand(0.25 * $size));
my $x0 = $r + int rand($size - 2 * $r);
my $y0 = $r + int rand($size - 2 * $r);
$im->line($x0-$r, $y0-$r, $x0+$r, $y0+$r, $color);
$im->line($x0-$r, $y0+$r, $x0+$r, $y0-$r, $color);
return 2*$r/$size
}
sub image_to_input {
my ($im, $type) = @_;
my @data;
for my $x (0..$size-1) {
for my $y (0..$size-1) {
push @data, $im->getPixel($x, $y);
}
}
return \@data;
}
sub make_train {
my $train = AI::FANN::TrainData->new_empty($num, $size * $size, 2);
for (0..$num - 1) {
print ".";
my $im = GD::Image->new($size, $size);
my $white = $im->colorAllocate(255,255,255);
my $black = $im->colorAllocate(0,0,0);
my $type = (rand > .5);
my $r = $type ? draw_x($im, $black) : draw_o($im, $black);
$train->data($_, image_to_input($im), [$type, $r]);
}
print "\n";
my $ann = AI::FANN->new_standard(@_);
for (1..40) {
$ann->train_on_data($train, 100, 1, 0.0001);
# $ann->print_connections;
$ann->print_parameters;
$ann->save("ox.ann");
}
}
sub make_test {
my $rep = shift;
my $ann = AI::FANN->new_from_file("ox.ann");
print "ann read\n";
for (0..$rep - 1) {
my $im = GD::Image->new($size, $size);
my $white = $im->colorAllocate(255,255,255);
my $black = $im->colorAllocate(0,0,0);
my $type = (rand > .5);
my $r = $type ? draw_x($im, $black) : draw_o($im, $black);
my $out = $ann->run(image_to_input($im));
( run in 0.267 second using v1.01-cache-2.11-cpan-4d50c553e7e )