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);
    /* Store the old values */
    const INTVAL old_x = attrs->x;
    const INTVAL old_y = attrs->y;
    FLOATVAL * old_s = attrs->storage;

    /* x and y are indices, not sizes. Resize the matrix to accomodate this
       new point without shrinking by taking the max. */
    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));

    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, 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;
    if (old_s)
        mem_sys_free(old_s);
}

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

/*

=head1 VTABLEs

=over 4

=item* init

=cut

*/

    VTABLE void init() {
        Parrot_NumMatrix2D_attributes * attr =
            (Parrot_NumMatrix2D_attributes *) PARROT_NUMMATRIX2D(SELF);
        attr->storage = NULL;
        attr->x = 0;
        attr->y = 0;
        attr->flags = 0;
        PObj_custom_destroy_SET(SELF);
    }

    VTABLE void destroy() {
        Parrot_NumMatrix2D_attributes * attr =
            (Parrot_NumMatrix2D_attributes *) PARROT_NUMMATRIX2D(SELF);
        FLOATVAL * const s = attr->storage;
        if (s)
            mem_sys_free(s);
    }

/*

=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;
        Parrot_NumMatrix2D_attributes * const attrs
          = (Parrot_NumMatrix2D_attributes *) PARROT_NUMMATRIX2D(SELF);
        const INTVAL x_size = attrs->x;
        const INTVAL 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) {
        Parrot_NumMatrix2D_attributes * const attrs
            = (Parrot_NumMatrix2D_attributes *) PARROT_NUMMATRIX2D(SELF);
        INTVAL x, y, 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);
    }

    VTABLE void set_pmc_keyed(PMC * key, PMC * value) {
        const FLOATVAL v = VTABLE_get_number(INTERP, value);
        VTABLE_set_number_keyed(INTERP, SELF, key, v);
    }

/*

=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 = IS_TRANSPOSED(attrs->flags) ?
                                    ITEM_XY_COLMAJOR(attrs->storage, x_size, y_size, x, y) :
                                    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 (IS_TRANSPOSED(selfattr->flags) || IS_TRANSPOSED(valattr->flags)) {
            Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_UNIMPLEMENTED,
              "NumMatrix2D: Transposed matrices not supported yet in add.");
        }

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

        dest = VTABLE_clone(INTERP, value);
        destattr = (Parrot_NumMatrix2D_attributes *) PARROT_NUMMATRIX2D(dest);

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

        return dest;
    }

    MULTI PMC *multiply(NumMatrix2D *value, PMC *dest) {
        INTVAL x_size = 0, y_size = 0;
        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 = NULL;

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

        if (selfattr->y != valattr->x) {
            Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_OUT_OF_BOUNDS,
              "NumMatrix2D:");
        }

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

        cblas_dgemm(CblasRowMajor,
            IS_TRANSPOSED_BLAS(selfattr->flags),
            IS_TRANSPOSED_BLAS(valattr->flags),
            x_size,
            selfattr->y,
            y_size,
            1.0,
            selfattr->storage,
            (IS_TRANSPOSED(selfattr->flags) ? y_size : x_size ),
            valattr->storage,
            (IS_TRANSPOSED(valattr->flags)  ? valattr->y : y_size ),
            1.0,
            destattr->storage,
            x_size
        );

        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_Integer);
            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_Integer);
            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_Integer);
            VTABLE_set_integer_native(INTERP, size, attrs->y * attrs->x);
            return size;
        }
        return PMCNULL;
    }

    VTABLE PMC * clone() {
        PMC * const c = pmc_new(INTERP, SELF->vtable->base_type);
        Parrot_NumMatrix2D_attributes * const old_atts =
            (Parrot_NumMatrix2D_attributes *)PARROT_NUMMATRIX2D(SELF);
        Parrot_NumMatrix2D_attributes * const new_atts =
            (Parrot_NumMatrix2D_attributes *)PARROT_NUMMATRIX2D(c);
        INTVAL x, y;
        INTVAL const x_size = old_atts->x;
        INTVAL const y_size = old_atts->y;
        INTVAL const newsize = x_size * y_size;
        FLOATVAL * old_s = old_atts->storage;
        FLOATVAL * new_s = (FLOATVAL *)mem_sys_allocate_zeroed(newsize * sizeof (FLOATVAL));
        for (x = 0; x < x_size; ++x) {
            for (y = 0; y < y_size; ++y) {
                ITEM_XY_ROWMAJOR(new_s, x_size, y_size, x, y) =
                    ITEM_XY_ROWMAJOR(old_s, x_size, y_size, x, y);
            }
        }
        new_atts->storage = new_s;
        new_atts->x = x_size;
        new_atts->y = y_size;
        return c;
    }

/*

=back

=head1 METHODS

=over 4

*/

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

    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 transpose() {
        Parrot_NumMatrix2D_attributes * const attrs =
            (Parrot_NumMatrix2D_attributes *) PARROT_NUMMATRIX2D(SELF);
        INTVAL tmp = 0;
        INTVAL transposed = IS_TRANSPOSED(attrs->flags);

        tmp = attrs->x;
        attrs->x = attrs->y;
        attrs->y = tmp;

        if (transposed)
            attrs->flags -= FLAG_TRANSPOSED;
        else
            attrs->flags += FLAG_TRANSPOSED;
        transposed = !transposed;
        RETURN(INTVAL transposed);
    }

    METHOD mem_transpose() {
        Parrot_NumMatrix2D_attributes * const attrs = 
            (Parrot_NumMatrix2D_attributes *) 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 new_size = new_x * new_y;
        FLOATVAL * new_s = (FLOATVAL *)mem_sys_allocate_zeroed(new_size * 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_attributes *) PARROT_NUMMATRIX2D(SELF);
        const INTVAL x_size = attrs->x;
        const INTVAL y_size = attrs->y;
        const INTVAL newsize = x_size * y_size;
        FLOATVAL * old_s = attrs->storage;
        FLOATVAL * new_s = (FLOATVAL *)mem_sys_allocate_zeroed(newsize * sizeof (FLOATVAL));

        INTVAL i, j;
        for (i = 0; i < x_size; i++) {
            for (j = 0; j < y_size; j++) {
                FLOATVAL value = ITEM_XY_ROWMAJOR(old_s, x_size, y_size, i, j);
                FLOATVAL result = 0.0;
                Parrot_ext_call(INTERP, func, "PNPf->N", SELF, value, args, &result);
                ITEM_XY_ROWMAJOR(new_s, x_size, y_size, i, j) = result;
            }
        }
        attrs->storage = new_s;
        free(old_s);
    }
/*

=back

=end

*/
}