nummatrix2d.pmc

#include "pla_matrix_types.h"
#include <cblas.h>


/* Resize the matrix internal storage to be able to hold a point at position
   (x, y). The matrix grows but does not shrink. New spaces in the matrix
   are initialized to 0.0. Parameters x and y are the indices that are trying
   to be accessed, so we must resize the matrix to be able to accomodate those
   indices. Notice that the matrix type is zero-indexed, so the size is one
   plus the highest index that we need to access. */
static void
resize_matrix(PARROT_INTERP, PMC * self, INTVAL x, INTVAL y)
{
    Parrot_NumMatrix2D_attributes * const attrs = PARROT_NUMMATRIX2D(self);
    const INTVAL old_x = attrs->x;
    const INTVAL old_y = attrs->y;
    const INTVAL new_x = INDEX_MAX(old_x, x + 1);
    const INTVAL new_y = INDEX_MAX(old_y, y + 1);
    const INTVAL newsize = new_x * new_y;
    FLOATVAL * new_s = (FLOATVAL *)mem_sys_allocate_zeroed(newsize * sizeof (FLOATVAL));
    FLOATVAL * old_s = attrs->storage;
    const INTVAL min_x = INDEX_MIN(old_x, new_x);
    const INTVAL min_y = INDEX_MIN(old_y, new_y);
    INTVAL i, j;
    for (i = 0; i < min_x; i++) {
        for (j = 0; j < min_y; j++) {
            ITEM_XY_ROWMAJOR(new_s, new_x, new_y, i, j) =
                ITEM_XY_ROWMAJOR(old_s, old_x, old_y, i, j);
        }
    }
    attrs->storage = new_s;
    attrs->x = new_x;
    attrs->y = new_y;
    free(old_s);
}



pmclass NumMatrix2D dynpmc auto_attrs {
    ATTR FLOATVAL * storage;
    ATTR INTVAL x;
    ATTR INTVAL y;

/*

=head1 VTABLEs

=over 4

=item* init

=cut

*/

    VTABLE void init() {
        PObj_custom_destroy_SET(SELF);
    }

/*

=item* get_number_keyed

=item* get_integer_keyed

=item* get_string_keyed

=item* get_pmc_keyed

=cut

*/

    VTABLE FLOATVAL get_number_keyed(PMC * key) {
        INTVAL x, y, x_size, y_size;
        Parrot_NumMatrix2D_attributes * const attrs
          = (Parrot_NumMatrix2D_attributes *) PARROT_NUMMATRIX2D(SELF);
        x_size = attrs->x;
        y_size = attrs->y;
        GET_INDICES_FROM_KEY(INTERP, key, x, y);
        if (x >= x_size || y >= y_size)
            Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_OUT_OF_BOUNDS,
                "NumMatrix2d: indices out of bounds");
        return ITEM_XY_ROWMAJOR(attrs->storage, x_size, y_size, x, y);
    }

    VTABLE INTVAL get_integer_keyed(PMC * key) {
        FLOATVAL f = VTABLE_get_number_keyed(INTERP, SELF, key);
        return (INTVAL)f;
    }

    VTABLE STRING * get_string_keyed(PMC * key) {
        FLOATVAL f = VTABLE_get_number_keyed(INTERP, SELF, key);
        STRING * const item = Parrot_sprintf_c(INTERP, "\t%f", f);
        return item;
    }

    VTABLE PMC * get_pmc_keyed(PMC * key) {
        FLOATVAL f = VTABLE_get_number_keyed(INTERP, SELF, key);
        PMC * const item = pmc_new(INTERP, enum_class_Float);
        VTABLE_set_number_native(INTERP, item, f);
        return item;
    }

/*

=item* get_number_keyed_int

=item* get_integer_keyed_int

=item* get_string_keyed_int

=item* get_pmc_keyed_int

=cut

*/

    VTABLE FLOATVAL get_number_keyed_int(INTVAL key) {
        Parrot_NumMatrix2D_attributes * const attrs
            = (Parrot_NumMatrix2D_attributes *) PARROT_NUMMATRIX2D(SELF);
        const INTVAL total_size = attrs->x * attrs->y;
        if (key >= total_size) {
            Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_OUT_OF_BOUNDS,
                                        "NumMatrix2D: Matrix dimensions must match in add.");
        }
        return attrs->storage[key];
    }

    VTABLE INTVAL get_integer_keyed_int(INTVAL key) {
        FLOATVAL f = VTABLE_get_number_keyed_int(INTERP, SELF, key);
        return (INTVAL)f;
    }

    VTABLE STRING * get_string_keyed_int(INTVAL key) {
        FLOATVAL f = VTABLE_get_number_keyed_int(INTERP, SELF, key);
        STRING * const item = Parrot_sprintf_c(INTERP, "\t%f", f);
        return item;
    }

    VTABLE PMC * get_pmc_keyed_int(INTVAL key) {
        FLOATVAL f = VTABLE_get_number_keyed_int(INTERP, SELF, key);
        PMC * const item = pmc_new(INTERP, enum_class_Float);
        VTABLE_set_number_native(INTERP, item, f);
        return item;
    }

/*

=item* set_number_keyed

=item* set_integer_keyed

=cut

*/

    VTABLE void set_number_keyed(PMC * key, FLOATVAL value) {
        INTVAL x, y, x_size, y_size;
        Parrot_NumMatrix2D_attributes * const attrs
            = (Parrot_NumMatrix2D_attributes *) PARROT_NUMMATRIX2D(SELF);
        x_size = attrs->x;
        y_size = attrs->y;
        GET_INDICES_FROM_KEY(INTERP, key, x, y);
        if (x >= x_size || y >= y_size) {
            resize_matrix(INTERP, SELF, x, y);
            x_size = attrs->x;
            y_size = attrs->y;
        }
        ITEM_XY_ROWMAJOR(attrs->storage, x_size, y_size, x, y) = value;
    }

    VTABLE void set_integer_keyed(PMC * key, INTVAL value) {
        VTABLE_set_number_keyed(INTERP, SELF, key, (FLOATVAL)value);
    }

/*

=item* get_string

=cut

*/

    VTABLE STRING *get_string() {
        INTVAL x, y, x_size, y_size;
        STRING *pstr = Parrot_str_new(INTERP, "", 0);
        STRING * const newline = Parrot_str_new(INTERP, "\n", 1);
        Parrot_NumMatrix2D_attributes * const attrs
          = (Parrot_NumMatrix2D_attributes *) PARROT_NUMMATRIX2D(SELF);
        x_size = attrs->x;
        y_size = attrs->y;

        for (x = 0; x < x_size; ++x) {
            for (y = 0; y < y_size; ++y) {
                const FLOATVAL f = ITEM_XY_ROWMAJOR(attrs->storage, x_size, y_size, x, y);
                STRING * const item = Parrot_sprintf_c(INTERP, "\t%f", f);
                pstr = Parrot_str_append(INTERP, pstr, item);
            }
            pstr = Parrot_str_append(INTERP, pstr, newline);
        }

        return pstr;
    }

    MULTI PMC *add(NumMatrix2D* value, PMC* dest) {
        int i = 0;
        INTVAL x_size, y_size;
        Parrot_NumMatrix2D_attributes * const selfattr
          = (Parrot_NumMatrix2D_attributes *) PARROT_NUMMATRIX2D(SELF);
        Parrot_NumMatrix2D_attributes * const valattr
          = (Parrot_NumMatrix2D_attributes *) PARROT_NUMMATRIX2D(value);
        Parrot_NumMatrix2D_attributes * destattr;

        x_size = selfattr->x;
        y_size = selfattr->y;

        if (x_size != valattr->x || y_size != valattr->y) {
            /* XXX: Throw a better exception. */
            Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_OUT_OF_BOUNDS,
              "NumMatrix2D: Matrix dimensions must match in add.");
        }

        /* TODO: dest is a copy of value. We could probably do this better. */
        /*       especially, as soon as we implement a clone method.        */
        dest = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
        resize_matrix(INTERP, dest, x_size - 1, y_size - 1);
        destattr = (Parrot_NumMatrix2D_attributes *) PARROT_NUMMATRIX2D(dest);

        memcpy(destattr->storage, valattr->storage, sizeof(FLOATVAL)*x_size*y_size);

        cblas_daxpy(x_size*y_size, 1, selfattr->storage, 1, destattr->storage, 1);

        return dest;
    }

    VTABLE PMC * get_attr_str(STRING * idx) {
        Parrot_NumMatrix2D_attributes * const attrs = 
            (Parrot_NumMatrix2D_attributes *)PARROT_NUMMATRIX2D(SELF);
        if (Parrot_str_equal(INTERP, idx, CONST_STRING(INTERP, "X"))) {
            PMC * const x = pmc_new(INTERP, enum_class_Intval);
            VTABLE_set_integer_native(INTERP, x, attrs->x);
            return x;
        }
        else if (Parrot_str_equal(INTERP, idx, CONST_STRING(INTERP, "Y"))) {
            PMC * const y = pmc_new(INTERP, enum_class_Intval);
            VTABLE_set_integer_native(INTERP, y, attrs->y);
            return y;
        }
        else if (Parrot_str_equal(INTERP, idx, CONST_STRING(INTERP, "size"))) {
            PMC * const size = pmc_new(INTERP, enum_class_Intval);
            VTABLE_set_integer_native(INTERP, size, attrs->y * attrs->x);
            return size;
        }
        return PMCNULL;
    }

    METHOD fill(FLOATVAL value) {
        Parrot_NumMatrix2D_attributes * const attrs
          = (Parrot_NumMatrix2D_attributes *) PARROT_NUMMATRIX2D(SELF);
        INTVAL x, y;
        INTVAL const x_size = attrs->x;
        INTVAL const y_size = attrs->y;

        for (x = 0; x < x_size; ++x) {
            for (y = 0; y < y_size; ++y) {
                ITEM_XY_ROWMAJOR(attrs->storage, x_size, y_size, x, y) = value;
            }
        }
    }

    METHOD resize(INTVAL new_x, INTVAL new_y) {
        resize_matrix(INTERP, SELF, new_x - 1, new_y - 1);
    }

    METHOD swap_column(INTVAL col_A, INTVAL col_b) {
    }

    METHOD swap_row(INTVAL row_a, INTVAL row_b) {
    }

    METHOD transpose() {
        Parrot_NumMatrix2D_attributes * const attrs = PARROT_NUMMATRIX2D(self);
        const INTVAL old_x = attrs->x;
        const INTVAL old_y = attrs->y;
        const INTVAL new_x = old_y
        const INTVAL new_y = old_x;
        const INTVAL size = new_x * new_y;
        FLOATVAL * new_s = (FLOATVAL *)mem_sys_allocate_zeroed(newsize * sizeof (FLOATVAL));
        FLOATVAL * old_s = attrs->storage;

        INTVAL i, j;
        for (i = 0; i < old_x; i++) {
            for (j = 0; j < old_y; j++) {
                ITEM_XY_ROWMAJOR(new_s, new_x, new_y, j, i) =
                    ITEM_XY_ROWMAJOR(old_s, old_x, old_y, i, j);
            }
        }
        attrs->storage = new_s;
        attrs->x = new_x;
        attrs->y = new_y;
        free(old_s);
    }

    METHOD iterate_function_inplace(PMC * func, PMC * args :slurpy) {
        Parrot_NumMatrix2D_attributes * const attrs = PARROT_NUMMATRIX2D(self);
        const INTVAL x = attrs->x;
        const INTVAL y = attrs->y;
        const INTVAL newsize = x * y;
        FLOATVAL * old_s = attrs->storage;
        FLOATVAL * new_s = (FLOATVAL *)mem_sys_allocate_zeroed(newsize * sizeof (FLOATVAL));

        INTVAL i, j;
        for (i = 0; i < min_x; i++) {
            for (j = 0; j < min_y; j++) {
                FLOATVAL value = ITEM_XY_ROWMAJOR(old_s, x, y, i, j);
                FLOATVAL result = 0.0;
                Parrot_ext_call(INTERP, func, "PiNPf->N", SELF, value, args, &result);
                ITEM_XY_ROWMAJOR(new_s, x, y, i, j) = result;
            }
        }
        attrs->storage = new_s;
        free(old_s);
    }
}