view release on metacpan or  search on metacpan

Simple.xs  view on Meta::CPAN

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

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