view release on metacpan or  search on metacpan

Simple.xs  view on Meta::CPAN

 * Build a Perl reference on array `av'.
 * This performs something like "$rv = \@av;" in Perl.
 */
SV *build_rv(AV *av)
{
    SV *rv;

    /*
     * To understand what is going on here, look at retrieve_ref()
     * in the Storable.xs file.  In particular, we don't perform
     * an SvREFCNT_inc(av) because the av we're supplying is going
     * to be referenced only by the REF we're building here.
     *        --RAM
     */

    rv = NEWSV(10002, 0);
    sv_upgrade(rv, SVt_RV);
    SvRV(rv) = (SV *) av;
    SvROK_on(rv);

    return rv;
}

/*
 * Build reference to a 2-dimensional array, implemented as an array
 * or array references.  The holding array has `rows' rows and each array
 * reference has `columns' entries.
 *
 * The name "axa" denotes the "product" of 2 arrays.
 */
SV *build_axaref(void *arena, int rows, int columns)
{
    AV *av;
    int i;
    double **p;

    av = newAV();
    av_extend(av, rows);

    for (i = 0, p = arena; i < rows; i++, p++) {
        int j;
        double *q;
        AV *av2;

        av2 = newAV();
        av_extend(av2, columns);

        for (j = 0, q = *p; j < columns; j++, q++)
            av_store(av2, j, newSVnv((NV) *q));

        av_store(av, i, build_rv(av2));
    }

    return build_rv(av);
}

#define EXPORT_VERSION    1
#define EXPORTED_ITEMS    9

/*
 * Exports the C data structures to the Perl world for serialization
 * by Storable.  We don't want to duplicate the logic of Storable here
 * even though we have to do some low-level Perl object construction.
 *
 * The structure we return is an array reference, which contains the
 * following items:
 *
 *  0    the export version number, in case format changes later
 *  1    the amount of neurons in the input layer
 *  2    the amount of neurons in the hidden layer
 *  3    the amount of neurons in the output layer
 *  4    the learning rate
 *  5    the sigmoid delta
 *  6    whether to use a bipolar (tanh) routine instead of the sigmoid
 *  7    [[weight.input_to_hidden[0]], [weight.input_to_hidden[1]], ...]
 *  8    [[weight.hidden_to_output[0]], [weight.hidden_to_output[1]], ...]
 */
SV *c_export_network(int handle)
{
    NEURAL_NETWORK *n = c_get_network(handle);
    AV *av;
    int i = 0;

    av = newAV();
    av_extend(av, EXPORTED_ITEMS);

    av_store(av, i++,  newSViv(EXPORT_VERSION));
    av_store(av, i++,  newSViv(n->size.input));
    av_store(av, i++,  newSViv(n->size.hidden));
    av_store(av, i++,  newSViv(n->size.output));
    av_store(av, i++,  newSVnv(n->learn_rate));
    av_store(av, i++,  newSVnv(n->delta));
    av_store(av, i++,  newSViv(n->use_bipolar));
    av_store(av, i++,
                build_axaref(n->weight.input_to_hidden,
                    n->size.input + 1, n->size.hidden + 1));
    av_store(av, i++,
                build_axaref(n->weight.hidden_to_output,
                    n->size.hidden + 1, n->size.output));

    if (i != EXPORTED_ITEMS)
        croak("BUG in c_export_network()");

    return build_rv(av);
}

/*
 * Load a Perl array of array (a matrix) with "rows" rows and "columns" columns
 * into the pre-allocated C array of arrays.
 *
 * The "hold" argument is an holding array and the Perl array of array which
 * we expect is at index "idx" within that holding array.
 */
void c_load_axa(AV *hold, int idx, void *arena, int rows, int columns)
{
    SV **sav;
    SV *rv;
    AV *av;
    int i;
    double **array = arena;

Simple.xs  view on Meta::CPAN

    /* 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;
            }
        }

        if (mse >= 0 && max_error <= mse)    /* Below their target! */
            break;
    }

    free(input);
    free(output);

    return max_error;
}

SV* c_infer(int handle, SV *array_ref)
{
    NEURAL_NETWORK *n = c_get_network(handle);
    int    i;
    AV     *perl_array, *result = newAV();

    /* feed the data */
    perl_array = get_array(array_ref);

    for (i = 0; i < n->size.input; i++)
        n->tmp[i] = get_float_element(perl_array, i);

    c_feed(n, n->tmp, NULL, 0); 

    /* read the results */
    for (i = 0; i < n->size.output; i++) {
        av_push(result, newSVnv(n->neuron.output[i]));
    }
    return newRV_noinc((SV*) result);
}

void c_feed(NEURAL_NETWORK *n, double *input, double *output, int learn)
{
    int i;

    for (i=0; i < n->size.input; i++) {
        n->neuron.input[i]  = input[i];
    }

    if (learn)
        for (i=0; i < n->size.output; i++)
            n->neuron.target[i] = output[i];

    c_feed_forward(n);

    if (learn) c_back_propagate(n); 
}

/*
 *  The original author of this code is M. Tim Jones <mtj@cogitollc.com> and
 *  written for the book "AI Application Programming", by Charles River Media.
 *
 *  It's been so heavily modified that it bears little resemblance to the
 *  original, but credit should be given where credit is due.  Therefore ...
 *
 *  Copyright (c) 2003 Charles River Media.  All rights reserved.
 * 
 *  Redistribution and use in source and binary forms, with or without
 *  modification, is hereby granted without fee provided that the following
 *  conditions are met:
 * 
 *    1.  Redistributions of source code must retain the above copyright
 *    notice, this list of conditions and the following disclaimer.  2.
 *    Redistributions in binary form must reproduce the above copyright
 *    notice, this list of conditions and the following disclaimer in the
 *    documentation and/or other materials provided with the distribution.  3.
 *    Neither the name of Charles River Media nor the names of its
 *    contributors may be used to endorse or promote products derived from
 *    this software without specific prior written permission.
 * 
 * THIS SOFTWARE IS PROVIDED BY CHARLES RIVER MEDIA AND CONTRIBUTORS 'AS IS'
 * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
 * IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE
 * ARE DISCLAIMED.  IN NO EVENT SHALL CHARLES RIVER MEDIA OR CONTRIBUTORS BE
 * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
 * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
 * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
 * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
 * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
 * POSSIBILITY OF SUCH DAMAGE.
 */

MODULE = AI::NeuralNet::Simple	PACKAGE = AI::NeuralNet::Simple

PROTOTYPES: DISABLE

int
is_array_ref (ref)
	SV *	ref

AV *
get_array (aref)
	SV *	aref

float
get_float_element (array, index)
	AV *	array
	int	index

SV *
get_element (array, index)
	AV *	array
	int	index

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)