AI-NeuralNet-Simple

 view release on metacpan or  search on metacpan

Changes  view on Meta::CPAN

Revision history for Perl extension AI::NeuralNet::Simple.

0.11  November 18, 2006
      Converted from Inline::C to XS
      No longer require 5.008.  5.005 and above should be fine.

0.10  December 29, 2005
      The following changes are all courtesy of Raphael Manfredi
      <Raphael_Manfredi [at] pobox.com>.
      Added tanh (bipolar) activation function.
      train_set() can now accept an error target to avoid over-training.
      Multiple network support.
      Persistence via storable.

0.02  September 21 2005
      Added pod and pod coverage tests
      Added Sub::Uplevel dependency to stop that annoying error failure :(

0.01  Sat Jan 31 12:19:00 2004
      Applied patch from "Daniel L. Ashbrook" <anjiro [at] cc.gatech.edu>
      to fix a small memory allocation bug in infer()

Simple.xs  view on Meta::CPAN

double sigmoid(NEURAL_NETWORK *n, double val);
double sigmoid_derivative(NEURAL_NETWORK *n, double val);
float  get_float_element(AV* array, int index);
int    is_array_ref(SV* ref);
void   c_assign_random_weights(NEURAL_NETWORK *);
void   c_back_propagate(NEURAL_NETWORK *);
void   c_destroy_network(int);
void   c_feed(NEURAL_NETWORK *, double *input, double *output, int learn);
void   c_feed_forward(NEURAL_NETWORK *);
float  c_get_learn_rate(int);
void   c_set_learn_rate(int, float);
SV*    c_export_network(int handle);
int    c_import_network(SV *);

#define ABS(x)        ((x) > 0.0 ? (x) : -(x))

int is_array_ref(SV* ref)
{
    if (SvROK(ref) && SvTYPE(SvRV(ref)) == SVt_PVAV)
        return 1;
    else

Simple.xs  view on Meta::CPAN

    return handle;
}

float c_get_learn_rate(int handle)
{
    NEURAL_NETWORK *n = c_get_network(handle);

    return n->learn_rate;
}

void c_set_learn_rate(int handle, float rate)
{
    NEURAL_NETWORK *n = c_get_network(handle);

    n->learn_rate = rate;
}

double c_get_delta(int handle)
{
    NEURAL_NETWORK *n = c_get_network(handle);

    return n->delta;
}


void c_set_delta(int handle, double delta)
{
    NEURAL_NETWORK *n = c_get_network(handle);

    n->delta = delta;
}

int c_get_use_bipolar(int handle)
{
    NEURAL_NETWORK *n = c_get_network(handle);

    return n->use_bipolar;
}

void c_set_use_bipolar(int handle, int bipolar)
{
    NEURAL_NETWORK *n = c_get_network(handle);

    n->use_bipolar = bipolar;
}

int c_create_network(NEURAL_NETWORK *n)
{
    int i;
    /* each of the next two variables has an extra row for the "bias" */

Simple.xs  view on Meta::CPAN

    if (!c_create_network(n))
        return -1;

    /* Perl already seeded the random number generator, via a rand(1) call */

    c_assign_random_weights(n);

    return handle;
}

double c_train_set(int handle, SV* set, int iterations, double mse)
{
    NEURAL_NETWORK *n = c_get_network(handle);
    AV     *input_array, *output_array; /* perl arrays */
    double *input, *output; /* C arrays */
    double max_error = 0.0;

    int set_length=0;
    int i,j;
    int index;

    set_length = av_len(get_array(set))+1;

    if (!set_length)
        croak("_train_set() array ref has no data");
    if (set_length % 2)
        croak("_train_set array ref must have an even number of elements");

    /* allocate memory for out input and output arrays */
    input_array    = get_array_from_aoa(set, 0);
    input          = malloc(sizeof(double) * set_length * (av_len(input_array)+1));

    output_array    = get_array_from_aoa(set, 1);
    output          = malloc(sizeof(double) * set_length * (av_len(output_array)+1));

    for (i=0; i < set_length; i += 2) {
        input_array = get_array_from_aoa(set, i);
        
        if (av_len(input_array)+1 != n->size.input)
            croak("Length of input data does not match");
        
        /* iterate over the input_array and assign the floats to input */
        
        for (j = 0; j < n->size.input; j++) {
            index = (i/2*n->size.input)+j;
            input[index] = get_float_element(input_array, j); 
        }
        
        output_array = get_array_from_aoa(set, i+1);
        if (av_len(output_array)+1 != n->size.output)
            croak("Length of output data does not match");

        for (j = 0; j < n->size.output; j++) {
            index = (i/2*n->size.output)+j;
            output[index] = get_float_element(output_array, j); 
        }
    }

    for (i = 0; i < iterations; i++) {
        max_error = 0.0;

        for (j = 0; j < (set_length/2); j++) {
            double error;

            c_feed(n, &input[j*n->size.input], &output[j*n->size.output], 1);

            if (mse >= 0.0 || i == iterations - 1) {
                error = mean_square_error(n, &output[j*n->size.output]);
                if (error > max_error)
                    max_error = error;
            }
        }

Simple.xs  view on Meta::CPAN

AV *
get_array_from_aoa (aref, index)
	SV *	aref
	int	index

float
c_get_learn_rate (handle)
	int	handle

void
c_set_learn_rate (handle, rate)
	int	handle
	float	rate
	PREINIT:
	I32* temp;
	PPCODE:
	temp = PL_markstack_ptr++;
	c_set_learn_rate(handle, rate);
	if (PL_markstack_ptr != temp) {
          /* truly void, because dXSARGS not invoked */
	  PL_markstack_ptr = temp;
	  XSRETURN_EMPTY; /* return empty stack */
        }
        /* must have used dXSARGS; list context implied */
	return; /* assume stack size is correct */

double
c_get_delta (handle)
	int	handle

void
c_set_delta (handle, delta)
	int	handle
	double	delta
	PREINIT:
	I32* temp;
	PPCODE:
	temp = PL_markstack_ptr++;
	c_set_delta(handle, delta);
	if (PL_markstack_ptr != temp) {
          /* truly void, because dXSARGS not invoked */
	  PL_markstack_ptr = temp;
	  XSRETURN_EMPTY; /* return empty stack */
        }
        /* must have used dXSARGS; list context implied */
	return; /* assume stack size is correct */

int
c_get_use_bipolar (handle)
	int	handle

void
c_set_use_bipolar (handle, bipolar)
	int	handle
	int	bipolar
	PREINIT:
	I32* temp;
	PPCODE:
	temp = PL_markstack_ptr++;
	c_set_use_bipolar(handle, bipolar);
	if (PL_markstack_ptr != temp) {
          /* truly void, because dXSARGS not invoked */
	  PL_markstack_ptr = temp;
	  XSRETURN_EMPTY; /* return empty stack */
        }
        /* must have used dXSARGS; list context implied */
	return; /* assume stack size is correct */

void
c_destroy_network (handle)

Simple.xs  view on Meta::CPAN

	SV *	input
	SV *	output

int
c_new_network (input, hidden, output)
	int	input
	int	hidden
	int	output

double
c_train_set (handle, set, iterations, mse)
	int	handle
	SV *	set
	int	iterations
	double	mse

SV *
c_infer (handle, array_ref)
	int	handle
	SV *	array_ref

examples/game_ai.pl  view on Meta::CPAN


use constant GOOD    => 2.0;
use constant AVERAGE => 1.0;
use constant POOR    => 0.0;

use constant YES     => 1.0;
use constant NO      => 0.0;

my $net = AI::NeuralNet::Simple->new(4,20,4);
$net->iterations(shift || 100000);
$net->train_set( [
#   health    knife gun  enemy
    [GOOD,    YES,  YES, 0],  WANDER,
    [GOOD,    YES,   NO, 2],  HIDE,
    [GOOD,    YES,   NO, 1],  ATTACK,
    [GOOD,    YES,   NO, 0],  WANDER,
    [GOOD,     NO,  YES, 2],  ATTACK,
    [GOOD,     NO,  YES, 1],  ATTACK,
    [GOOD,     NO,   NO, 3],  HIDE,
    [GOOD,     NO,   NO, 2],  HIDE,
    [GOOD,     NO,   NO, 1],  RUN,

lib/AI/NeuralNet/Simple.pm  view on Meta::CPAN

    }
    my $seed = rand(1);    # Perl invokes srand() on first call to rand()
    my $handle = c_new_network(@args);
    logdie "could not create new network" unless $handle >= 0;
    my $self = bless {
        input  => $args[0],
        hidden => $args[1],
        output => $args[2],
        handle => $handle,
    }, $class;
    $self->iterations(10000);    # set a reasonable default
}

sub train {
    my ( $self, $inputref, $outputref ) = @_;
    return c_train( $self->handle, $inputref, $outputref );
}

sub train_set {
    my ( $self, $set, $iterations, $mse ) = @_;
    $iterations ||= $self->iterations;
    $mse = -1.0 unless defined $mse;
    return c_train_set( $self->handle, $set, $iterations, $mse );
}

sub iterations {
    my ( $self, $iterations ) = @_;
    if ( defined $iterations ) {
        logdie "iterations() value must be a positive integer."
          unless $iterations
          and $iterations =~ /^\d+$/;
        $self->{iterations} = $iterations;
        return $self;
    }
    $self->{iterations};
}

sub delta {
    my ( $self, $delta ) = @_;
    return c_get_delta( $self->handle )              unless defined $delta;
    logdie "delta() value must be a positive number" unless $delta > 0.0;
    c_set_delta( $self->handle, $delta );
    return $self;
}

sub use_bipolar {
    my ( $self, $bipolar ) = @_;
    return c_get_use_bipolar( $self->handle ) unless defined $bipolar;
    c_set_use_bipolar( $self->handle, $bipolar );
    return $self;
}

sub infer {
    my ( $self, $data ) = @_;
    c_infer( $self->handle, $data );
}

sub winner {

lib/AI/NeuralNet/Simple.pm  view on Meta::CPAN

        $largest = $_ if $arrayref->[$_] > $arrayref->[$largest];
    }
    return $largest;
}

sub learn_rate {
    my ( $self, $rate ) = @_;
    return c_get_learn_rate( $self->handle ) unless defined $rate;
    logdie "learn rate must be between 0 and 1, exclusive"
      unless $rate > 0 && $rate < 1;
    c_set_learn_rate( $self->handle, $rate );
    return $self;
}

sub DESTROY {
    my $self = shift;
    c_destroy_network( $self->handle );
}

#
# Serializing hook for Storable

lib/AI/NeuralNet/Simple.pm  view on Meta::CPAN

just searching with Google.)

Once the activation function is applied, the output is then sent through the
next synapse, where it will be multiplied by w4 and the process will continue.

=head2 C<AI::NeuralNet::Simple> architecture

The architecture used by this module has (at present) 3 fixed layers of
neurons: an input, hidden, and output layer.  In practice, a 3 layer network is
applicable to many problems for which a neural network is appropriate, but this
is not always the case.  In this module, we've settled on a fixed 3 layer
network for simplicity.

Here's how a three layer network might learn "logical or".  First, we need to
determine how many inputs and outputs we'll have.  The inputs are simple, we'll
choose two inputs as this is the minimum necessary to teach a network this
concept.  For the outputs, we'll also choose two neurons, with the neuron with
the highest output value being the "true" or "false" response that we are
looking for.  We'll only have one neuron for the hidden layer.  Thus, we get a
network that resembles the following:

lib/AI/NeuralNet/Simple.pm  view on Meta::CPAN


This is choosing the number of layers and the number of neurons per layer.  In
C<AI::NeuralNet::Simple>, the number of layers is fixed.

With more complete neural net packages, you can also pick which activation
functions you wish to use and the "learn rate" of the neurons.

=item 2 Training

This involves feeding the neural network enough data until the error rate is
low enough to be acceptable.  Often we have a large data set and merely keep
iterating until the desired error rate is achieved.

=item 3 Measuring results

One frequent mistake made with neural networks is failing to test the network
with different data from the training data.  It's quite possible for a
backpropagation network to hit what is known as a "local minimum" which is not
truly where it should be.  This will cause false results.  To check for this,
after training we often feed in other known good data for verification.  If the
results are not satisfactory, perhaps a different number of neurons per layer
should be tried or a different set of training data should be supplied.

=back

=head1 Programming C<AI::NeuralNet::Simple>

=head2 C<new($input, $hidden, $output)>

C<new()> accepts three integers.  These number represent the number of nodes in
the input, hidden, and output layers, respectively.  To create the "logical or"
network described earlier:

lib/AI/NeuralNet/Simple.pm  view on Meta::CPAN

	T(x) = tanh(delta * x)
	tanh(x) = (exp(x) - exp(-x)) / (exp(x) + exp(-x))

which allows the network to have neurons negatively impacting the weight,
since T() is a signed function between (-1,+1) whereas S() only falls
within (0,1).

=head2 C<delta($delta)>

Fetches the current I<delta> used in activation functions to scale the
signal, or sets the new I<delta>. The higher the delta, the steeper the
activation function will be.  The argument must be strictly positive.

You should not change I<delta> during the traning.

=head2 C<use_bipolar($boolean)>

Returns whether the network currently uses a bipolar activation function.
If an argument is supplied, instruct the network to use a bipolar activation
function or not.

You should not change the activation function during the traning.

=head2 C<train(\@input, \@output)>

This method trains the network to associate the input data set with the output
data set.  Representing the "logical or" is as follows:

  $net->train([1,1] => [0,1]);
  $net->train([1,0] => [0,1]);
  $net->train([0,1] => [0,1]);
  $net->train([0,0] => [1,0]);

Note that a one pass through the data is seldom sufficient to train a network.
In the example "logical or" program, we actually run this data through the
network ten thousand times.

  for (1 .. 10000) {
    $net->train([1,1] => [0,1]);
    $net->train([1,0] => [0,1]);
    $net->train([0,1] => [0,1]);
    $net->train([0,0] => [1,0]);
  }

The routine returns the Mean Squared Error (MSE) representing how far the
network answered.

It is far preferable to use C<train_set()> as this lets you control the MSE
over the training set and it is more efficient because there are less memory
copies back and forth.

=head2 C<train_set(\@dataset, [$iterations, $mse])>

Similar to train, this method allows us to train an entire data set at once.
It is typically faster than calling individual "train" methods.  The first
argument is expected to be an array ref of pairs of input and output array
refs.

The second argument is the number of iterations to train the set.  If
this argument is not provided here, you may use the C<iterations()> method to
set it (prior to calling C<train_set()>, of course).  A default of 10,000 will
be provided if not set.

The third argument is the targeted Mean Square Error (MSE). When provided,
the traning sequence will compute the maximum MSE seen during an iteration
over the training set, and if it is less than the supplied target, the
training stops.  Computing the MSE at each iteration costs, but you are
certain to not over-train your network.

  $net->train_set([
    [1,1] => [0,1],
    [1,0] => [0,1],
    [0,1] => [0,1],
    [0,0] => [1,0],
  ], 10000, 0.01);

The routine returns the MSE of the last iteration, which is the highest MSE
seen over the whole training set (and not an average MSE).

=head2 C<iterations([$integer])>

If called with a positive integer argument, this method will allow you to set
number of iterations that train_set will use and will return the network
object.  If called without an argument, it will return the number of iterations
it was set to.

  $net->iterations;         # returns 100000
  my @training_data = ( 
    [1,1] => [0,1],
    [1,0] => [0,1],
    [0,1] => [0,1],
    [0,0] => [1,0],
  );
  $net->iterations(100000) # let's have lots more iterations!
      ->train_set(\@training_data);
  
=head2 C<learn_rate($rate)>)

This method, if called without an argument, will return the current learning
rate.  .20 is the default learning rate.

If called with an argument, this argument must be greater than zero and less
than one.  This will set the learning rate and return the object.
  
  $net->learn_rate; #returns the learning rate
  $net->learn_rate(.1)
      ->iterations(100000)
      ->train_set(\@training_data);

If you choose a lower learning rate, you will train the network slower, but you
may get a better accuracy.  A higher learning rate will train the network
faster, but it can have a tendancy to "overshoot" the answer when learning and
not learn as accurately.

=head2 C<infer(\@input)>

This method, if provided with an input array reference, will return an array
reference corresponding to the output values that it is guessing.  Note that

lib/AI/NeuralNet/Simple.pm  view on Meta::CPAN


"AI Application Programming by M. Tim Jones, copyright (c) by Charles River
Media, Inc.  

The C code in this module is based heavily upon Mr. Jones backpropogation
network in the book.  The "game ai" example in the examples directory is based
upon an example he has graciously allowed me to use.  I I<had> to use it
because it's more fun than many of the dry examples out there :)

"Naturally Intelligent Systems", by Maureen Caudill and Charles Butler,
copyright (c) 1990 by Massachussetts Institute of Technology.

This book is a decent introduction to neural networks in general.  The forward
feed back error propogation is but one of many types.

=head1 AUTHORS

Curtis "Ovid" Poe, C<ovid [at] cpan [dot] org>

Multiple network support, persistence, export of MSE (mean squared error),
training until MSE below a given threshold and customization of the

t/10nn_simple.t  view on Meta::CPAN

    qr/^\QArguments to new() must be positive integers\E/,
    '... and supplying new() with bad arguments should also die';

my $net = $CLASS->new(2,1,2);
ok($net, 'Calling new with good arguments should succeed');
isa_ok($net, $CLASS => '...and the object it returns');

can_ok($net, 'learn_rate');
throws_ok {$net->learn_rate(2)}
    qr/^\QLearn rate must be between 0 and 1, exclusive\E/,
    '... and setting it outside of legal boundaries should die';
is(sprintf("%.1f", $net->learn_rate), "0.2", '... and it should have the correct learn rate');
isa_ok($net->learn_rate(.3), $CLASS => '... and setting it should return the object');
is(sprintf("%.1f", $net->learn_rate), "0.3", '... and should set it correctly');
$net->learn_rate(.2);

can_ok($net, 'train');

# teach the network logical 'or'

ok($net->train([1,1], [0,1]), 'Calling train() with valid data should succeed');
for (1 .. 10000) {
    $net->train([1,1],[0,1]);
    $net->train([1,0],[0,1]);

t/10nn_simple.t  view on Meta::CPAN

can_ok($net, 'winner');
is($net->winner([1,1]), 1, '... and it should return the index of the highest valued result');
is($net->winner([1,0]), 1, '... and it should return the index of the highest valued result');
is($net->winner([0,1]), 1, '... and it should return the index of the highest valued result');
is($net->winner([0,0]), 0, '... and it should return the index of the highest valued result');

# teach the network logical 'and' using the tanh() activation with delta=2
$net = $CLASS->new(2,1,2);
$net->delta(2);
$net->use_bipolar(1);
my $mse = $net->train_set([
	[1,1] => [0,1],
	[1,0] => [1,0],
	[0,1] => [1,0],
	[0,0] => [1,0],
], 10000, 0.2);

is($net->winner([1,1]), 1, '1 AND 1 = 1');
is($net->winner([1,0]), 0, '1 AND 0 = 0');
is($net->winner([0,1]), 0, '0 AND 1 = 0');
is($net->winner([0,0]), 0, '0 AND 0 = 0');

t/20nn_multi.t  view on Meta::CPAN

};

can_ok($CLASS, 'new');

my $net1 = $CLASS->new(2,1,2);
ok($net1, 'Calling new with good arguments should succeed');
isa_ok($net1, $CLASS => '...and the object it returns');

can_ok($net1, 'learn_rate');
is(sprintf("%.1f", $net1->learn_rate), "0.2", '... and it should have the correct learn rate');
isa_ok($net1->learn_rate(.5), $CLASS => '... and setting it should return the object');
is(sprintf("%.1f", $net1->learn_rate), "0.5", '... and should set it correctly');

my $net2 = $CLASS->new(5,8,2);
ok($net2, 'Calling new with good arguments should succeed');
isa_ok($net2, $CLASS => '...and the object it returns');

can_ok($net2, 'learn_rate');
is(sprintf("%.1f", $net2->learn_rate), "0.2", '... and it should have the correct learn rate');
isa_ok($net2->learn_rate(.3), $CLASS => '... and setting it should return the object');
is(sprintf("%.1f", $net2->learn_rate), "0.3", '... and should set it correctly');
$net2->learn_rate(.2);

t/pod-coverage.t  view on Meta::CPAN

    build_rv
    c_destroy_network
    c_export_network
    c_get_delta
    c_get_learn_rate
    c_get_use_bipolar
    c_import_network
    c_infer
    c_load_axa
    c_new_network
    c_set_delta
    c_set_learn_rate
    c_set_use_bipolar
    c_train
    c_train_set
    get_array
    get_array_from_aoa
    get_element
    get_float_element
    handle
    is_array_ref
);

pod_coverage_ok( "AI::NeuralNet::Simple", { trustme => [$ignore] } );



( run in 1.690 second using v1.01-cache-2.11-cpan-49f99fa48dc )