view release on metacpan or  search on metacpan

Simple.xs  view on Meta::CPAN

    sav = av_fetch(hold, idx, 0);
    if (sav == NULL)
        croak("serialized item %d is not defined", idx);

    rv = *sav;
    if (!is_array_ref(rv))
        croak("serialized item %d is not an array reference", idx);

    av = get_array(rv);        /* This is an array of array refs */

    for (i = 0; i < rows; i++) {
        double *row = array[i];
        int j;
        AV *subav;

        sav = av_fetch(av, i, 0);
        if (sav == NULL)
            croak("serialized item %d has undefined row %d", idx, i);
        rv = *sav;
        if (!is_array_ref(rv))
            croak("row %d of serialized item %d is not an array ref", i, idx);

        subav = get_array(rv);

        for (j = 0; j < columns; j++)
            row[j] = get_float_element(subav, j);
    }
}

/*
 * Create new network from a retrieved data structure, such as the one
 * produced by c_export_network().
 */
int c_import_network(SV *rv)
{
    NEURAL_NETWORK *n;
    int handle;
    SV **sav;
    AV *av;
    int i = 0;

    /*
     * Unfortunately, since those data come from the outside, we need
     * to validate most of the structural information to make sure
     * we're not fed garbage or something we cannot process, like a
     * newer version of the serialized data. This makes the code heavy.
     *        --RAM
     */

    if (!is_array_ref(rv))
        croak("c_import_network() not given an array reference");

    av = get_array(rv);

    /* Check version number */
    sav = av_fetch(av, i++, 0);
    if (sav == NULL || SvIVx(*sav) != EXPORT_VERSION)
        croak("c_import_network() given unknown version %d",
            sav == NULL ? 0 : SvIVx(*sav));

    /* Check length -- at version 1, length is fixed to 13 */
    if (av_len(av) + 1 != EXPORTED_ITEMS)
        croak("c_import_network() not given a %d-item array reference",
            EXPORTED_ITEMS);

    handle = c_new_handle();
    n = c_get_network(handle);

    sav = av_fetch(av, i++, 0);
    if (sav == NULL)
        croak("undefined input size (item %d)", i - 1);
    n->size.input  = SvIVx(*sav);

    sav = av_fetch(av, i++, 0);
    if (sav == NULL)
        croak("undefined hidden size (item %d), i - 1");
    n->size.hidden = SvIVx(*sav);

    sav = av_fetch(av, i++, 0);
    if (sav == NULL)
        croak("undefined output size (item %d)", i - 1);
    n->size.output = SvIVx(*sav);

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

    sav = av_fetch(av, i++, 0);
    if (sav == NULL)
        croak("undefined learn_rate (item %d)", i - 1);
    n->learn_rate = SvNVx(*sav);

    sav = av_fetch(av, i++, 0);
    if (sav == NULL)
        croak("undefined delta (item %d)", i - 1);
    n->delta = SvNVx(*sav);

    sav = av_fetch(av, i++, 0);
    if (sav == NULL)
        croak("undefined use_bipolar (item %d)", i - 1);
    n->use_bipolar = SvIVx(*sav);

    c_load_axa(av, i++, n->weight.input_to_hidden,
        n->size.input + 1, n->size.hidden + 1);
    c_load_axa(av, i++, n->weight.hidden_to_output,
        n->size.hidden + 1, n->size.output);

    return handle;
}

/*
 * Support functions for back propogation
 */

void c_assign_random_weights(NEURAL_NETWORK *n)
{
    int hid, inp, out;

    for (inp = 0; inp < n->size.input + 1; inp++) {
        for (hid = 0; hid < n->size.hidden; hid++) {
            n->weight.input_to_hidden[inp][hid] = RAND_WEIGHT;
        }

Simple.xs  view on Meta::CPAN

        n->error.hidden[hid] = 0.0;
        for (out = 0; out < n->size.output; out++) {
            n->error.hidden[hid] 
                += n->error.output[out] 
                 * n->weight.hidden_to_output[hid][out];
        }
        n->error.hidden[hid] 
            *= (*activation_derivative)(n, n->neuron.hidden[hid]);
    }

    /* update the weights for the output layer (step 4) */
    for (out = 0; out < n->size.output; out++) {
        for (hid = 0; hid < n->size.hidden; hid++) {
            n->weight.hidden_to_output[hid][out] 
                += (n->learn_rate 
                  * n->error.output[out] 
                  * n->neuron.hidden[hid]);
        }

        /* update the bias */
        n->weight.hidden_to_output[n->size.hidden][out] 
            += (n->learn_rate 
              * n->error.output[out]);
    }

    /* update the weights for the hidden layer (step 4) */
    for (hid = 0; hid < n->size.hidden; hid++) {

        for  (inp = 0; inp < n->size.input; inp++) {
            n->weight.input_to_hidden[inp][hid] 
                += (n->learn_rate 
                  * n->error.hidden[hid] 
                  * n->neuron.input[inp]);
        }

        /* update the bias */
        n->weight.input_to_hidden[n->size.input][hid] 
            += (n->learn_rate 
              * n->error.hidden[hid]);
    }
}

/*
 * Compute the Mean Square Error between the actual output and the
 * targeted output.
 */
double mean_square_error(NEURAL_NETWORK *n, double *target)
{
    double error = 0.0;
    int i;

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

    return 0.5 * error;
}

double c_train(int handle, SV* input, SV* output)
{
    NEURAL_NETWORK *n = c_get_network(handle);
    int i,length;
    AV *array;
    double *input_array  = malloc(sizeof(double) * n->size.input);
    double *output_array = malloc(sizeof(double) * n->size.output);
    double error;

    if (! is_array_ref(input) || ! is_array_ref(output)) {
        croak("train() takes two arrayrefs.");
    }
    
    array  = get_array(input);
    length = av_len(array)+ 1;
    
    if (length != n->size.input) {
        croak("Length of input array does not match network");
    }
    for (i = 0; i < length; i++) {
        input_array[i] = get_float_element(array, i);
    }

    array  = get_array(output);
    length = av_len(array) + 1;
    
    if (length != n->size.output) {
        croak("Length of output array does not match network");
    }
    for (i = 0; i < length; i++) {
        output_array[i] = get_float_element(array, i);
    }

    c_feed(n, input_array, output_array, 1);
    error = mean_square_error(n, output_array);

    free(input_array);
    free(output_array);

    return error;
}

int c_new_network(int input, int hidden, int output)
{
    NEURAL_NETWORK *n;
    int handle;

    handle = c_new_handle();
    n = c_get_network(handle);

    n->size.input  = input;
    n->size.hidden = hidden;
    n->size.output = output;

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

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

/*