AI-FANN
view release on metacpan or search on metacpan
#include "XSUB.h"
#include "ppport.h"
#include <doublefann.h>
#include "morefann.h"
#include "constants.h"
#define WANT_MORTAL 1
typedef fann_type *fta; /* fta: fann_type array */
typedef fta fta_input;
typedef fta fta_output;
static SV *
_obj2sv(pTHX_ void *ptr, SV * klass, char * ctype) {
if (ptr) {
SV *rv;
SV *sv = newSVpvf("%s(0x%p)", ctype, ptr);
SV *mgobj = sv_2mortal(newSViv(PTR2IV(ptr)));
SvREADONLY_on(mgobj);
sv_magic(sv, mgobj, '~', ctype, 0);
/* SvREADONLY_on(sv); */
rv = newRV_noinc(sv);
if (SvOK(klass)) {
HV *stash;
if (SvROK(klass))
stash = SvSTASH(klass);
else
stash = gv_stashsv(klass, 1);
sv_bless(rv, stash);
}
return rv;
}
return &PL_sv_undef;
}
static void *
_sv2obj(pTHX_ SV* self, char * ctype, int required) {
SV *sv = SvRV(self);
if (sv) {
if (SvTYPE(sv) == SVt_PVMG) {
MAGIC *mg = mg_find(sv, '~');
if (mg) {
if (strcmp(ctype, mg->mg_ptr) == 0 && mg->mg_obj) {
return INT2PTR(void *, SvIV(mg->mg_obj));
}
}
}
}
if (required) {
Perl_croak(aTHX_ "object of class %s expected", ctype);
}
return NULL;
}
static SV *
_fta2sv(pTHX_ fann_type *fta, unsigned int len) {
unsigned int i;
AV *av = newAV();
av_extend(av, len - 1);
for (i = 0; i < len; i++) {
SV *sv = newSVnv(fta[i]);
av_store(av, i, sv);
}
return newRV_noinc((SV*)av);
}
if (SvTYPE((SV*)av)==SVt_PVAV) {
if (av_len(av)+1 == len) {
return av;
}
else {
Perl_croak(aTHX_ "wrong number of elements in %s array, %d found when %d were required",
name, (unsigned int)(av_len(av)+1), len);
}
}
}
Perl_croak(aTHX_ "wrong type for %s argument, array reference expected", name);
}
static fann_type*
_sv2fta(pTHX_ SV *sv, unsigned int len, int flags, char * const name) {
unsigned int i;
fann_type *fta;
AV *av = _srv2av(aTHX_ sv, len, name);
Newx(fta, len, fann_type);
if (flags & WANT_MORTAL) SAVEFREEPV(fta);
for (i = 0; i < len; i++) {
SV ** svp = av_fetch(av, i, 0);
fta[i] = SvNV(svp ? *svp : &PL_sv_undef);
}
return fta;
}
static void
fta_output
fann_run(self, input)
struct fann *self;
fta_input input;
CLEANUP:
_check_error(aTHX_ (struct fann_error *)self);
void
fann_randomize_weights(self, min_weight, max_weight)
struct fann *self;
fann_type min_weight;
fann_type max_weight;
CLEANUP:
_check_error(aTHX_ (struct fann_error *)self);
void
fann_train(self, input, desired_output)
struct fann *self;
fta_input input;
fta_output desired_output;
CLEANUP:
_check_error(aTHX_ (struct fann_error *)self);
}
void
fann_cascade_activation_steepnesses(self, ...)
struct fann *self;
PREINIT:
unsigned int count;
PPCODE:
if (items > 1) {
unsigned int i;
fann_type * steepnesses;
count = items - 1;
Newx(steepnesses, items - 1, fann_type);
SAVEFREEPV(steepnesses);
for (i = 0; i < count; i++) {
steepnesses[i] = SvNV(ST(i+1));
}
fann_set_cascade_activation_steepnesses(self, steepnesses, count);
}
count = fann_get_cascade_activation_steepnesses_count(self);
if (GIMME_V == G_ARRAY) {
unsigned int i;
fann_type * steepnesses = fann_get_cascade_activation_steepnesses(self);
EXTEND(SP, count);
for (i = 0; i < count; i++) {
ST(i) = sv_2mortal(newSVuv(steepnesses[i]));
}
XSRETURN(count);
}
else {
ST(0) = sv_2mortal(newSVuv(count));
XSRETURN(1);
}
void
fann_train_data_shuffle(self)
struct fann_train_data *self;
CLEANUP:
_check_error(aTHX_ (struct fann_error *)self);
void
fann_train_data_scale_input(self, new_min, new_max)
struct fann_train_data *self;
fann_type new_min;
fann_type new_max;
CLEANUP:
_check_error(aTHX_ (struct fann_error *)self);
void
fann_train_data_scale_output(self, new_min, new_max)
struct fann_train_data *self;
fann_type new_min;
fann_type new_max;
CLEANUP:
_check_error(aTHX_ (struct fann_error *)self);
void
fann_train_data_scale(self, new_min, new_max)
struct fann_train_data *self;
fann_type new_min;
fann_type new_max;
CLEANUP:
_check_error(aTHX_ (struct fann_error *)self);
struct fann_train_data*
fann_train_data_subset(self, pos, length)
struct fann_train_data *self;
unsigned int pos;
unsigned int length;
CLEANUP:
_check_error(aTHX_ (struct fann_error *)self);
Changes
FANN.xs
morefann.c
morefann.h
accessors.xsh
constants.h
typemap
genaccessors
genconstants
Makefile.PL
MANIFEST
ppport.h
README
t/AI-FANN.t
t/pods.t
lib/AI/FANN.pm
samples/ox.pl
--- #YAML:1.0
name: AI-FANN
version: 0.10
abstract: Perl wrapper for the Fast Artificial Neural Network library
license: ~
author:
- Salvador Fandiño <sfandino@yahoo.com>
generated_by: ExtUtils::MakeMaker version 6.42
distribution_type: module
requires:
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.3.html
version: 1.3
DEPENDENCIES
This module requires the FANN library version 2.1.0beta or later
compiled to use doubles internally.
The module Test::More is also required for testing.
INSTALLATION
To install this module type the following:
perl Makefile.PL
make
make test
make install
You may need to add two extra parameters to the Makefile.PL script to
indicate where to find the FANN library and include files if they are
not installed on some standard locations. For instance:
accessors.xsh view on Meta::CPAN
}
RETVAL = fann_get_learning_momentum(self);
OUTPUT:
RETVAL
CLEANUP:
_check_error(aTHX_ (struct fann_error *)self);
MODULE = AI::FANN PACKAGE = AI::FANN PREFIX = accessor_
fann_type
accessor_bit_fail_limit(self, value = NO_INIT)
struct fann * self;
fann_type value
CODE:
if (items > 1) {
fann_set_bit_fail_limit(self, value);
}
RETVAL = fann_get_bit_fail_limit(self);
OUTPUT:
RETVAL
CLEANUP:
_check_error(aTHX_ (struct fann_error *)self);
accessors.xsh view on Meta::CPAN
}
RETVAL = fann_get_cascade_candidate_stagnation_epochs(self);
OUTPUT:
RETVAL
CLEANUP:
_check_error(aTHX_ (struct fann_error *)self);
MODULE = AI::FANN PACKAGE = AI::FANN PREFIX = accessor_
fann_type
accessor_cascade_weight_multiplier(self, value = NO_INIT)
struct fann * self;
fann_type value
CODE:
if (items > 1) {
fann_set_cascade_weight_multiplier(self, value);
}
RETVAL = fann_get_cascade_weight_multiplier(self);
OUTPUT:
RETVAL
CLEANUP:
_check_error(aTHX_ (struct fann_error *)self);
MODULE = AI::FANN PACKAGE = AI::FANN PREFIX = accessor_
fann_type
accessor_cascade_candidate_limit(self, value = NO_INIT)
struct fann * self;
fann_type value
CODE:
if (items > 1) {
fann_set_cascade_candidate_limit(self, value);
}
RETVAL = fann_get_cascade_candidate_limit(self);
OUTPUT:
RETVAL
CLEANUP:
_check_error(aTHX_ (struct fann_error *)self);
accessors.xsh view on Meta::CPAN
struct fann * self;
enum fann_activationfunc_enum value;
CODE:
fann_set_activation_function_output(self, value);
CLEANUP:
_check_error(aTHX_ (struct fann_error *)self);
MODULE = AI::FANN PACKAGE = AI::FANN PREFIX = accessor_
fann_type
accessor_neuron_activation_steepness(self, layer, neuron, value = NO_INIT)
struct fann * self;
unsigned int layer;
unsigned int neuron;
fann_type value
CODE:
if (items > 3) {
fann_set_activation_steepness(self, value, layer, neuron);
}
RETVAL = fann_get_activation_steepness(self, layer, neuron);
OUTPUT:
RETVAL
CLEANUP:
_check_error(aTHX_ (struct fann_error *)self);
MODULE = AI::FANN PACKAGE = AI::FANN PREFIX = accessor_
void
accessor_layer_activation_steepness(self, layer, value)
struct fann * self;
unsigned int layer;
fann_type value;
CODE:
fann_set_activation_steepness_layer(self, value, layer);
CLEANUP:
_check_error(aTHX_ (struct fann_error *)self);
MODULE = AI::FANN PACKAGE = AI::FANN PREFIX = accessor_
void
accessor_hidden_activation_steepness(self, value)
struct fann * self;
fann_type value;
CODE:
fann_set_activation_steepness_hidden(self, value);
CLEANUP:
_check_error(aTHX_ (struct fann_error *)self);
MODULE = AI::FANN PACKAGE = AI::FANN PREFIX = accessor_
void
accessor_output_activation_steepness(self, value)
struct fann * self;
fann_type value;
CODE:
fann_set_activation_steepness_output(self, value);
CLEANUP:
_check_error(aTHX_ (struct fann_error *)self);
MODULE = AI::FANN PACKAGE = AI::FANN PREFIX = accessor_
unsigned int
accessor_layer_num_neurons(self, layer)
genaccessors view on Meta::CPAN
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;
my @ixs1 = grep !/^value$/, @ixs;
my $nixs = @ixs;
my $types = join("\n ", "$struct self;", map "unsigned int $_;", @ixs1);
my $args = join(', ', 'self', @ixs1);
my $setargs = join(', ', 'self', @ixs);
if ($getter) {
if ($getter =~ /^->/) {
$getter = "self->$getter"
}
else {
$getter = "$getter($args)"
}
genaccessors view on Meta::CPAN
print <<HEAD;
MODULE = AI::FANN PACKAGE = $package PREFIX = accessor_
HEAD
if ($setter and $getter) {
print <<EOA
$type
accessor_$method($args, value = NO_INIT)
$types
$type value
CODE:
if (items > $nixs) {
$setter;
}
RETVAL = $getter;
OUTPUT:
RETVAL
EOA
}
elsif ($getter) {
print <<EOA;
$type
accessor_$method($args)
$types
CODE:
RETVAL = $getter;
OUTPUT:
RETVAL
EOA
}
elsif ($setter) {
print <<EOA;
void
accessor_$method($args, value)
$types
$type value;
CODE:
$setter;
EOA
}
else {
die "both setter and getter are null"
}
print <<EOA;
genaccessors view on Meta::CPAN
accessor(@args);
}
__DATA__
training_algorithm, enum fann_train_enum, fann_get_training_algorithm, fann_set_training_algorithm
train_error_function, enum fann_errorfunc_enum, fann_get_train_error_function, fann_set_train_error_function
train_stop_function, enum fann_stopfunc_enum, fann_get_train_stop_function, fann_set_train_stop_function
learning_rate, double, fann_get_learning_rate, fann_set_learning_rate
learning_momentum, double, fann_get_learning_momentum, fann_set_learning_momentum
bit_fail_limit, fann_type, fann_get_bit_fail_limit, fann_set_bit_fail_limit
quickprop_decay, double, fann_get_quickprop_decay, fann_set_quickprop_decay
quickprop_mu, double, fann_get_quickprop_mu, fann_set_quickprop_mu
rprop_increase_factor, double, fann_get_rprop_increase_factor, fann_set_rprop_increase_factor
rprop_decrease_factor, double, fann_get_rprop_decrease_factor, fann_set_rprop_decrease_factor
rprop_delta_min, double, fann_get_rprop_delta_min, fann_set_rprop_delta_min
rprop_delta_max, double, fann_get_rprop_delta_max, fann_set_rprop_delta_max
num_inputs, unsigned int, fann_get_num_input
num_outputs, unsigned int, fann_get_num_output
total_neurons, unsigned int, fann_get_total_neurons
total_connections, unsigned int, fann_get_total_connections
connection_rate, double, fann_get_connection_rate
MSE, double, fann_get_MSE
bit_fail, unsigned int, fann_get_bit_fail
cascade_output_change_fraction, double, fann_get_cascade_output_change_fraction, fann_set_cascade_output_change_fraction
cascade_output_stagnation_epochs, double, fann_get_cascade_output_stagnation_epochs, fann_set_cascade_output_stagnation_epochs
cascade_candidate_change_fraction, double, fann_get_cascade_candidate_change_fraction, fann_set_cascade_candidate_change_fraction
cascade_candidate_stagnation_epochs, unsigned int, fann_get_cascade_candidate_stagnation_epochs, fann_set_cascade_candidate_stagnation_epochs
cascade_weight_multiplier, fann_type, fann_get_cascade_weight_multiplier, fann_set_cascade_weight_multiplier
cascade_candidate_limit, fann_type, fann_get_cascade_candidate_limit, fann_set_cascade_candidate_limit
cascade_max_out_epochs, unsigned int, fann_get_cascade_max_out_epochs, fann_set_cascade_max_out_epochs
cascade_max_cand_epochs, unsigned int, fann_get_cascade_max_cand_epochs, fann_set_cascade_max_cand_epochs
cascade_num_candidates, unsigned int, fann_get_cascade_num_candidates
cascade_num_candidate_groups, unsigned int, fann_get_cascade_num_candidate_groups, fann_set_cascade_num_candidate_groups
neuron_activation_function, enum fann_activationfunc_enum, fann_get_activation_function, fann_set_activation_function, value, layer, neuron_index
layer_activation_function, enum fann_activationfunc_enum, , fann_set_activation_function_layer, value, layer
hidden_activation_function, enum fann_activationfunc_enum, , fann_set_activation_function_hidden
output_activation_function, enum fann_activationfunc_enum, , fann_set_activation_function_output
neuron_activation_steepness, fann_type, fann_get_activation_steepness, fann_set_activation_steepness, value, layer, neuron
layer_activation_steepness, fann_type, , fann_set_activation_steepness_layer, value, layer
hidden_activation_steepness, fann_type, , fann_set_activation_steepness_hidden
output_activation_steepness, fann_type, , fann_set_activation_steepness_output
layer_num_neurons, unsigned int, fann_get_num_neurons, , layer
num_layers, unsigned int, fann_get_num_layers
# neuron, struct fann_neuron *, fann_get_neuron, , layer, neuron_index
TrainData::num_inputs, unsigned int, fann_train_data_num_input
TrainData::num_outputs, unsigned int, fann_train_data_num_output
TrainData::length, unsigned int, fann_train_data_length
lib/AI/FANN.pm view on Meta::CPAN
the library.
AI::FANN object oriented interface provides an almost direct map to
the C library API. Some differences have been introduced to make it
more perlish:
=over 4
=item *
Two classes are used: C<AI::FANN> that wraps the C C<struct fann> type
and C<AI::FANN::TrainData> that wraps C<struct fann_train_data>.
=item *
Prefixes and common parts on the C function names referring to those
structures have been removed. For instance C
C<fann_train_data_shuffle> becomes C<AI::FANN::TrainData::shuffle> that
will be usually called as...
$train_data->shuffle;
lib/AI/FANN.pm view on Meta::CPAN
exception. No manual error checking is required after calling FANN
functions.
=item *
Memory management is automatic, no need to call destroy methods.
=item *
Doubles are used for computations (using floats or fixed
point types is not supported).
=back
=head1 CONSTANTS
All the constants defined in the C documentation are exported from the module:
# import all...
use AI::FANN ':all';
lib/AI/FANN.pm view on Meta::CPAN
# enum fann_stopfunc_enum:
FANN_STOPFUNC_MSE
FANN_STOPFUNC_BIT
=head1 CLASSES
The classes defined by this package are:
=head2 AI::FANN
Wraps C C<struct fann> types and provides the following methods
(consult the C documentation for a full description of their usage):
=over 4
=item AI::FANN->new_standard(@layer_sizes)
-
=item AI::FANN->new_sparse($connection_rate, @layer_sizes)
#include "morefann.h"
#include <string.h>
static fann_type **allocvv(unsigned int n1, unsigned int n2) {
fann_type **ptr = (fann_type **)malloc(n1 * sizeof(fann_type *));
fann_type *v = (fann_type *)malloc(n1 * n2 * sizeof(fann_type));
if (ptr && v) {
unsigned int i;
for (i = 0; i < n1; i++) {
ptr[i] = v + i * n2;
}
return ptr;
}
return 0;
}
data->num_input = num_input;
data->num_output = num_output;
return data;
}
}
return 0;
}
void
fann_train_data_set(struct fann_train_data *data, unsigned int ix,
fann_type *input, fann_type *output ) {
if (ix < data->num_data) {
memcpy(data->input[ix], input, data->num_input * sizeof(fann_type));
memcpy(data->output[ix], output, data->num_output * sizeof(fann_type));
}
else {
fann_error((struct fann_error *)data, FANN_E_INDEX_OUT_OF_BOUND, ix);
}
}
/*
enum fann_activationfunc_enum
fann_get_activation_function(struct fann *ann, unsigned int layer, int neuron_index) {
struct fann_neuron *neuron = fann_get_neuron(ann, layer, neuron_index);
if (neuron) {
return neuron->activation_function;
}
return 0;
}
*/
/*
fann_type
fann_get_activation_steepness(struct fann *ann, unsigned int layer, int neuron_index) {
struct fann_neuron *neuron = fann_get_neuron(ann, layer, neuron_index);
if (neuron) {
return neuron->activation_steepness;
}
return 0;
}
*/
/*
#include <doublefann.h>
void
fann_train_data_set(struct fann_train_data *data, unsigned int ix,
fann_type *input, fann_type *output );
struct fann_train_data *
fann_train_data_create(unsigned int num_data,
unsigned int num_input, unsigned int num_output);
struct fann_layer*
fann_get_layer(struct fann *ann, int layer);
struct fann_neuron*
av_len|||
av_make|||
av_pop|||
av_push|||
av_reify|||
av_shift|||
av_store|||
av_undef|||
av_unshift|||
ax|||n
bad_type|||
bind_match|||
block_end|||
block_gimme||5.004000|
block_start|||
boolSV|5.004000||p
boot_core_PerlIO|||
boot_core_UNIVERSAL|||
boot_core_mro|||
boot_core_xsutils|||
bytes_from_utf8||5.007001|
call_list||5.004000|
call_method|5.006000||p
call_pv|5.006000||p
call_sv|5.006000||p
calloc||5.007002|n
cando|||
cast_i32||5.006000|
cast_iv||5.006000|
cast_ulong||5.006000|
cast_uv||5.006000|
check_type_and_open|||
check_uni|||
checkcomma|||
checkposixcc|||
ckWARN|5.006000||p
ck_anoncode|||
ck_bitop|||
ck_concat|||
ck_defined|||
ck_delete|||
ck_die|||
newPVOP|||
newRANGE|||
newRV_inc|5.004000||p
newRV_noinc|5.004000||p
newRV|||
newSLICEOP|||
newSTATEOP|||
newSUB|||
newSVOP|||
newSVREF|||
newSV_type||5.009005|
newSVhek||5.009003|
newSViv|||
newSVnv|||
newSVpvf_nocontext|||vn
newSVpvf||5.004000|v
newSVpvn_share|5.007001||p
newSVpvn|5.004050||p
newSVpvs_share||5.009003|
newSVpvs|5.009003||p
newSVpv|||
newSV|||
newTOKEN|||
newUNOP|||
newWHENOP||5.009003|
newWHILEOP||5.009003|
newXS_flags||5.009004|
newXSproto||5.006000|
newXS||5.006000|
new_collate||5.006000|
new_constant|||
new_ctype||5.006000|
new_he|||
new_logop|||
new_numeric||5.006000|
new_stackinfo||5.005000|
new_version||5.009000|
new_warnings_bitfield|||
next_symbol|||
nextargv|||
nextchar|||
ninstr|||
packWARN|5.007003||p
pack_cat||5.007003|
pack_rec|||
package|||
packlist||5.008001|
pad_add_anon|||
pad_add_name|||
pad_alloc|||
pad_block_start|||
pad_check_dup|||
pad_compname_type|||
pad_findlex|||
pad_findmy|||
pad_fixup_inner_anons|||
pad_free|||
pad_leavemy|||
pad_new|||
pad_peg|||n
pad_push|||
pad_reset|||
pad_setsv|||
save_vptr||5.006000|
savepvn|||
savepvs||5.009003|
savepv|||
savesharedpvn||5.009005|
savesharedpv||5.007003|
savestack_grow_cnt||5.008001|
savestack_grow|||
savesvpv||5.009002|
sawparens|||
scalar_mod_type|||n
scalarboolean|||
scalarkids|||
scalarseq|||
scalarvoid|||
scalar|||
scan_bin||5.006000|
scan_commit|||
scan_const|||
scan_formline|||
scan_heredoc|||
sv_pvbyte||5.006000|
sv_pvn_force_flags|5.007002||p
sv_pvn_force|||
sv_pvn_nomg|5.007003||p
sv_pvn|||
sv_pvutf8n_force||5.006000|
sv_pvutf8n||5.006000|
sv_pvutf8||5.006000|
sv_pv||5.006000|
sv_recode_to_utf8||5.007003|
sv_reftype|||
sv_release_COW|||
sv_replace|||
sv_report_used|||
sv_reset|||
sv_rvweaken||5.006000|
sv_setiv_mg|5.004050||p
sv_setiv|||
sv_setnv_mg|5.006000||p
sv_setnv|||
sv_setpv_mg|5.004050||p
sv_utf8_upgrade_flags||5.007002|
sv_utf8_upgrade||5.007001|
sv_uv|5.005000||p
sv_vcatpvf_mg|5.006000|5.004000|p
sv_vcatpvfn||5.004000|
sv_vcatpvf|5.006000|5.004000|p
sv_vsetpvf_mg|5.006000|5.004000|p
sv_vsetpvfn||5.004000|
sv_vsetpvf|5.006000|5.004000|p
sv_xmlpeek|||
svtype|||
swallow_bom|||
swap_match_buff|||
swash_fetch||5.007002|
swash_get|||
swash_init||5.006000|
sys_intern_clear|||
sys_intern_dup|||
sys_intern_init|||
taint_env|||
taint_proper|||
$file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_${func}_GLOBAL\b.*$LF//mg);
}
}
$file{needs_inc_ppport} = keys %{$file{uses}};
if ($file{needs_inc_ppport}) {
my $pp = '';
for $func (sort keys %{$file{needs}}) {
my $type = $file{needs}{$func};
next if $type eq 'extern';
my $suffix = $type eq 'global' ? '_GLOBAL' : '';
unless (exists $file{"needed_$type"}{$func}) {
if ($type eq 'global') {
diag("Files [@{$global{needs}{$func}}] need $func, adding global request");
}
else {
diag("File needs $func, adding static request");
}
$pp .= "#define NEED_$func$suffix\n";
}
}
if ($pp && ($c =~ s/^(?=$HS*#$HS*define$HS+NEED_\w+)/$pp/m)) {
#ifndef dNOOP
# define dNOOP extern int /*@unused@*/ Perl___notused PERL_UNUSED_DECL
#endif
#ifndef NVTYPE
# if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE)
# define NVTYPE long double
# else
# define NVTYPE double
# endif
typedef NVTYPE NV;
#endif
#ifndef INT2PTR
# if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE)
# define PTRV UV
# define INT2PTR(any,d) (any)(d)
# else
# if PTRSIZE == LONGSIZE
# define PTRV unsigned long
#endif
/*
* Boilerplate macros for initializing and accessing interpreter-local
* data from C. All statics in extensions should be reworked to use
* this, if you want to make the extension thread-safe. See ext/re/re.xs
* for an example of the use of these macros.
*
* Code that uses these macros is responsible for the following:
* 1. #define MY_CXT_KEY to a unique string, e.g. "DynaLoader_guts"
* 2. Declare a typedef named my_cxt_t that is a structure that contains
* all the data that needs to be interpreter-local.
* 3. Use the START_MY_CXT macro after the declaration of my_cxt_t.
* 4. Use the MY_CXT_INIT macro such that it is called exactly once
* (typically put in the BOOT: section).
* 5. Use the members of the my_cxt_t structure everywhere as
* MY_CXT.member.
* 6. Use the dMY_CXT macro (a declaration) in all the functions that
* access MY_CXT.
*/
#define Perl_grok_number DPPP_(my_grok_number)
#if defined(NEED_grok_number) || defined(NEED_grok_number_GLOBAL)
int
DPPP_(my_grok_number)(pTHX_ const char *pv, STRLEN len, UV *valuep)
{
const char *s = pv;
const char *send = pv + len;
const UV max_div_10 = UV_MAX / 10;
const char max_mod_10 = UV_MAX % 10;
int numtype = 0;
int sawinf = 0;
int sawnan = 0;
while (s < send && isSPACE(*s))
s++;
if (s == send) {
return 0;
} else if (*s == '-') {
s++;
numtype = IS_NUMBER_NEG;
}
else if (*s == '+')
s++;
if (s == send)
return 0;
/* next must be digit or the radix separator or beginning of infinity */
if (isDIGIT(*s)) {
/* UVs are at least 32 bits, so the first 9 decimal digits cannot
break;
}
if (digit >= 0 && digit <= 9
&& (s < send)) {
/* value overflowed.
skip the remaining digits, don't
worry about setting *valuep. */
do {
s++;
} while (s < send && isDIGIT(*s));
numtype |=
IS_NUMBER_GREATER_THAN_UV_MAX;
goto skip_value;
}
}
}
}
}
}
}
}
}
}
}
}
}
}
}
}
}
}
numtype |= IS_NUMBER_IN_UV;
if (valuep)
*valuep = value;
skip_value:
if (GROK_NUMERIC_RADIX(&s, send)) {
numtype |= IS_NUMBER_NOT_INT;
while (s < send && isDIGIT(*s)) /* optional digits after the radix */
s++;
}
}
else if (GROK_NUMERIC_RADIX(&s, send)) {
numtype |= IS_NUMBER_NOT_INT | IS_NUMBER_IN_UV; /* valuep assigned below */
/* no digits before the radix means we need digits after it */
if (s < send && isDIGIT(*s)) {
do {
s++;
} while (s < send && isDIGIT(*s));
if (valuep) {
/* integer approximation is valid - it's 0. */
*valuep = 0;
}
}
} else if (*s == 'N' || *s == 'n') {
/* XXX TODO: There are signaling NaNs and quiet NaNs. */
s++; if (s == send || (*s != 'A' && *s != 'a')) return 0;
s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
s++;
sawnan = 1;
} else
return 0;
if (sawinf) {
numtype &= IS_NUMBER_NEG; /* Keep track of sign */
numtype |= IS_NUMBER_INFINITY | IS_NUMBER_NOT_INT;
} else if (sawnan) {
numtype &= IS_NUMBER_NEG; /* Keep track of sign */
numtype |= IS_NUMBER_NAN | IS_NUMBER_NOT_INT;
} else if (s < send) {
/* we can have an optional exponent part */
if (*s == 'e' || *s == 'E') {
/* The only flag we keep is sign. Blow away any "it's UV" */
numtype &= IS_NUMBER_NEG;
numtype |= IS_NUMBER_NOT_INT;
s++;
if (s < send && (*s == '-' || *s == '+'))
s++;
if (s < send && isDIGIT(*s)) {
do {
s++;
} while (s < send && isDIGIT(*s));
}
else
return 0;
}
}
while (s < send && isSPACE(*s))
s++;
if (s >= send)
return numtype;
if (len == 10 && memEQ(pv, "0 but true", 10)) {
if (valuep)
*valuep = 0;
return IS_NUMBER_IN_UV;
}
return 0;
}
#endif
#endif
samples/ox.pl view on Meta::CPAN
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));
printf ("type: %f, r: %4.2f out type: %f, r: %4.2f\n", $type, $r, $out->[0], $out->[1]);
}
}
if ($ARGV[0] eq 'train') {
make_train($size * $size, 4 * $size * $size, 240, 200, 60, 20, 2);
}
elsif ($ARGV[0] eq 'test') {
make_test($ARGV[1] || 10);
}
else {
TYPEMAP
struct fann * T_PTROBJ_MAGIC
struct fann_train_data * T_PTROBJ_MAGIC
fann_type T_DOUBLE
fta_input T_FTA_INPUT
fta_output T_FTA_OUTPUT
enum fann_train_enum T_UV
enum fann_stopfunc_enum T_UV
enum fann_errorfunc_enum T_UV
enum fann_activationfunc_enum T_UV
enum fann_train_enum T_FANN_TRAIN_ENUM
enum fann_activationfunc_enum T_FANN_ACTIVATIONFUNC_ENUM
enum fann_errorfunc_enum T_FANN_ERRORFUNC_ENUM
enum fann_stopfunc_enum T_STOPFUNC_ENUM
INPUT
T_PTROBJ_MAGIC
$var = ($type)_sv2obj(aTHX_ $arg, \"${type}\", 1);
T_FTA_INPUT
$var = _sv2fta(aTHX_ $arg, self->num_input, WANT_MORTAL, \"${var}\");
T_FTA_OUTPUT
$var = _sv2fta(aTHX_ $arg, self->num_output, WANT_MORTAL, \"${var}\");
T_FANN_TRAIN_ENUM
$var = _sv2fann_train_enum($arg)
T_FANN_ERRORFUNC_ENUM
$var = _sv2fann_errorfunc_enum($arg)
T_STOPFUNC_ENUM
$var = _sv2fann_stopfunc_enum($arg)
OUTPUT
T_PTROBJ_MAGIC
$arg = _obj2sv(aTHX_ $var, ST(0), "$type");
T_FTA_OUTPUT
$arg = _fta2sv(aTHX_ $var, self->num_output);
T_FANN_TRAIN_ENUM
$arg = _fann_train_enum2sv($var);
T_FANN_ACTIVATIONFUNC_ENUM
$arg = _fann_activationfunc_enum2sv($var);
( run in 4.229 seconds using v1.01-cache-2.11-cpan-df04353d9ac )