kmat 0.0.3

data/ext/kmat/smat/convert.c

@@ -0,0 +1,375 @@
+#include "../kmat.h"
+
+// alias to_m!
+VALUE
+kmm_mat_to_mat_destl(int argc, VALUE *argv, VALUE self)
+{
+	rb_check_arity(argc, 0, 1);
+	if ( argc == 0 ) {
+		return self;
+	} else {
+		VT_SWITCH( km_sym2vt(argv[0]),
+			return kmm_mat_to_fmat_destl(self);,
+			return kmm_mat_to_cmat_destl(self);,
+			return kmm_mat_to_imat_destl(self);,
+			return kmm_mat_to_bmat_destl(self);,
+			return kmm_mat_to_omat_destl(self);
+		);
+	}
+}
+
+// alias to_m
+VALUE
+kmm_mat_to_mat(int argc, VALUE *argv, VALUE self)
+{
+	rb_check_arity(argc, 0, 1);
+	if ( argc == 0 ) {
+		return rb_funcall(self, id_dup, 0);
+	} else {
+		VT_SWITCH( km_sym2vt(argv[0]),
+			return kmm_mat_to_fmat(self);,
+			return kmm_mat_to_cmat(self);,
+			return kmm_mat_to_imat(self);,
+			return kmm_mat_to_bmat(self);,
+			return kmm_mat_to_omat(self);
+		);
+	}
+}
+
+
+struct km_conv_arg {
+	union {
+		void *body;
+		double *dbody;
+		COMPLEX *zbody;
+		int *ibody;
+		bool *bbody;
+		VALUE *vbody;
+	};
+	int ldb;
+};
+
+static void
+z2d_func(COMPLEX *ent, int i, int j, void *data_)
+{
+	struct km_conv_arg *data = (struct km_conv_arg *)data_;
+	(data->dbody)[i+j*(data->ldb)] = creal(*ent);
+}
+static void
+i2d_func(int *ent, int i, int j, void *data_)
+{
+	struct km_conv_arg *data = (struct km_conv_arg *)data_;
+	(data->dbody)[i+j*(data->ldb)] = (double)*ent;
+}
+static void
+b2d_func(bool *ent, int i, int j, void *data_)
+{
+	struct km_conv_arg *data = (struct km_conv_arg *)data_;
+	(data->dbody)[i+j*(data->ldb)] = (*ent ? 1.0 : 0.0);
+}
+static void
+v2d_func(VALUE *ent, int i, int j, void *data_)
+{
+	struct km_conv_arg *data = (struct km_conv_arg *)data_;
+	(data->dbody)[i+j*(data->ldb)] = NUM2DBL(*ent);
+}
+VALUE
+kmm_mat_to_fmat_destl(VALUE self)
+{
+	km_check_frozen(self);
+	SMAT *src = km_mat2smat(self);
+	if ( src->vtype == VT_DOUBLE ) {
+		return self;
+	}
+	SMAT *dest = km_smat_alloc(src->m, src->n, VT_DOUBLE);
+	struct km_conv_arg data = {{dest->body}, dest->ld};
+	VT_SWITCH( src->vtype,
+		rb_raise(km_eInternal, "unexpected reach");,
+		km_smat_each_with_index_z(src, z2d_func, &data);,
+		km_smat_each_with_index_i(src, i2d_func, &data);,
+		km_smat_each_with_index_b(src, b2d_func, &data);,
+		km_smat_each_with_index_v(src, v2d_func, &data);
+	);
+	km_smat_copy(src, dest);
+	return self;
+}
+VALUE
+kmm_mat_to_fmat(VALUE self)
+{
+	km_check_frozen(self);
+	SMAT *src = km_mat2smat(self);
+	if ( src->vtype == VT_DOUBLE ) {
+		return rb_funcall(self, id_dup, 0);
+	}
+	VALUE ret = km_Mat(src->m, src->n, VT_DOUBLE);
+	SMAT *dest = km_mat2smat(ret);
+	struct km_conv_arg data = {{dest->body}, dest->ld};
+	VT_SWITCH( src->vtype,
+		rb_raise(km_eInternal, "unexpected reach");,
+		km_smat_each_with_index_z(src, z2d_func, &data);,
+		km_smat_each_with_index_i(src, i2d_func, &data);,
+		km_smat_each_with_index_b(src, b2d_func, &data);,
+		km_smat_each_with_index_v(src, v2d_func, &data);
+	);
+	return ret;
+}
+
+static void
+d2z_func(double *ent, int i, int j, void *data_)
+{
+	struct km_conv_arg *data = (struct km_conv_arg *)data_;
+	(data->zbody)[i+j*(data->ldb)] = cpack(*ent, 0.0);
+}
+static void
+i2z_func(int *ent, int i, int j, void *data_)
+{
+	struct km_conv_arg *data = (struct km_conv_arg *)data_;
+	(data->zbody)[i+j*(data->ldb)] = cpack((double)*ent, 0.0);
+}
+static void
+b2z_func(bool *ent, int i, int j, void *data_)
+{
+	struct km_conv_arg *data = (struct km_conv_arg *)data_;
+	(data->zbody)[i+j*(data->ldb)] = (*ent ? cpack(1.0, 0.0) : cpack(0.0, 0.0));
+}
+static void
+v2z_func(VALUE *ent, int i, int j, void *data_)
+{
+	struct km_conv_arg *data = (struct km_conv_arg *)data_;
+	(data->zbody)[i+j*(data->ldb)] = km_v2c(*ent);
+}
+VALUE
+kmm_mat_to_cmat_destl(VALUE self)
+{
+	km_check_frozen(self);
+	SMAT *src = km_mat2smat(self);
+	if ( src->vtype == VT_COMPLEX ) {
+		return self;
+	}
+	SMAT *dest = km_smat_alloc(src->m, src->n, VT_COMPLEX);
+	struct km_conv_arg data = {{dest->body}, dest->ld};
+	VT_SWITCH( src->vtype,
+		km_smat_each_with_index_d(src, d2z_func, &data);,
+		rb_raise(km_eInternal, "unexpected reach");,
+		km_smat_each_with_index_i(src, i2z_func, &data);,
+		km_smat_each_with_index_b(src, b2z_func, &data);,
+		km_smat_each_with_index_v(src, v2z_func, &data);
+	);
+	km_smat_copy(src, dest);
+	return self;
+}
+VALUE
+kmm_mat_to_cmat(VALUE self)
+{
+	km_check_frozen(self);
+	SMAT *src = km_mat2smat(self);
+	if ( src->vtype == VT_COMPLEX ) {
+		return rb_funcall(self, id_dup, 0);
+	}
+	VALUE ret = km_Mat(src->m, src->n, VT_COMPLEX);
+	SMAT *dest = km_mat2smat(ret);
+	struct km_conv_arg data = {{dest->body}, dest->ld};
+	VT_SWITCH( src->vtype,
+		km_smat_each_with_index_d(src, d2z_func, &data);,
+		rb_raise(km_eInternal, "unexpected reach");,
+		km_smat_each_with_index_i(src, i2z_func, &data);,
+		km_smat_each_with_index_b(src, b2z_func, &data);,
+		km_smat_each_with_index_v(src, v2z_func, &data);
+	);
+	return ret;
+}
+
+static void
+d2i_func(double *ent, int i, int j, void *data_)
+{
+	struct km_conv_arg *data = (struct km_conv_arg *)data_;
+	(data->ibody)[i+j*(data->ldb)] = (int)(*ent);
+}
+static void
+z2i_func(COMPLEX *ent, int i, int j, void *data_)
+{
+	struct km_conv_arg *data = (struct km_conv_arg *)data_;
+	(data->ibody)[i+j*(data->ldb)] = (int)creal(*ent);
+}
+static void
+b2i_func(bool *ent, int i, int j, void *data_)
+{
+	struct km_conv_arg *data = (struct km_conv_arg *)data_;
+	(data->ibody)[i+j*(data->ldb)] = (*ent ? 1 : 0);
+}
+static void
+v2i_func(VALUE *ent, int i, int j, void *data_)
+{
+	struct km_conv_arg *data = (struct km_conv_arg *)data_;
+	(data->ibody)[i+j*(data->ldb)] = NUM2INT(*ent);
+}
+VALUE
+kmm_mat_to_imat_destl(VALUE self)
+{
+	km_check_frozen(self);
+	SMAT *src = km_mat2smat(self);
+	if ( src->vtype == VT_INT ) {
+		return self;
+	}
+	SMAT *dest = km_smat_alloc(src->m, src->n, VT_INT);
+	struct km_conv_arg data = {{dest->body}, dest->ld};
+	VT_SWITCH( src->vtype,
+		km_smat_each_with_index_d(src, d2i_func, &data);,
+		km_smat_each_with_index_z(src, z2i_func, &data);,
+		rb_raise(km_eInternal, "unexpected reach");,
+		km_smat_each_with_index_b(src, b2i_func, &data);,
+		km_smat_each_with_index_v(src, v2i_func, &data);
+	);
+	km_smat_copy(src, dest);
+	return self;
+}
+VALUE
+kmm_mat_to_imat(VALUE self)
+{
+	km_check_frozen(self);
+	SMAT *src = km_mat2smat(self);
+	if ( src->vtype == VT_INT ) {
+		return rb_funcall(self, id_dup, 0);
+	}
+	VALUE ret = km_Mat(src->m, src->n, VT_INT);
+	SMAT *dest = km_mat2smat(ret);
+	struct km_conv_arg data = {{dest->body}, dest->ld};
+	VT_SWITCH( src->vtype,
+		km_smat_each_with_index_d(src, d2i_func, &data);,
+		km_smat_each_with_index_z(src, z2i_func, &data);,
+		rb_raise(km_eInternal, "unexpected reach");,
+		km_smat_each_with_index_b(src, b2i_func, &data);,
+		km_smat_each_with_index_v(src, v2i_func, &data);
+	);
+	return ret;
+}
+
+static void
+d2b_func(double *ent, int i, int j, void *data_)
+{
+	struct km_conv_arg *data = (struct km_conv_arg *)data_;
+	(data->bbody)[i+j*(data->ldb)] = (*ent != 0.0);
+}
+static void
+z2b_func(COMPLEX *ent, int i, int j, void *data_)
+{
+	struct km_conv_arg *data = (struct km_conv_arg *)data_;
+	(data->bbody)[i+j*(data->ldb)] = (*ent != cpack(0.0, 0.0));
+}
+static void
+i2b_func(int *ent, int i, int j, void *data_)
+{
+	struct km_conv_arg *data = (struct km_conv_arg *)data_;
+	(data->bbody)[i+j*(data->ldb)] = (*ent != 0);
+}
+static void
+v2b_func(VALUE *ent, int i, int j, void *data_)
+{
+	struct km_conv_arg *data = (struct km_conv_arg *)data_;
+	(data->bbody)[i+j*(data->ldb)] = RTEST(*ent);
+}
+VALUE
+kmm_mat_to_bmat_destl(VALUE self)
+{
+	km_check_frozen(self);
+	SMAT *src = km_mat2smat(self);
+	if ( src->vtype == VT_BOOL ) {
+		return self;
+	}
+	SMAT *dest = km_smat_alloc(src->m, src->n, VT_BOOL);
+	struct km_conv_arg data = {{dest->body}, dest->ld};
+	VT_SWITCH( src->vtype,
+		km_smat_each_with_index_d(src, d2b_func, &data);,
+		km_smat_each_with_index_z(src, z2b_func, &data);,
+		km_smat_each_with_index_i(src, i2b_func, &data);,
+		rb_raise(km_eInternal, "unexpected reach");,
+		km_smat_each_with_index_v(src, v2b_func, &data);
+	);
+	km_smat_copy(src, dest);
+	return self;
+}
+VALUE
+kmm_mat_to_bmat(VALUE self)
+{
+	km_check_frozen(self);
+	SMAT *src = km_mat2smat(self);
+	if ( src->vtype == VT_BOOL ) {
+		return rb_funcall(self, id_dup, 0);
+	}
+	VALUE ret = km_Mat(src->m, src->n, VT_BOOL);
+	SMAT *dest = km_mat2smat(ret);
+	struct km_conv_arg data = {{dest->body}, dest->ld};
+	VT_SWITCH( src->vtype,
+		km_smat_each_with_index_d(src, d2b_func, &data);,
+		km_smat_each_with_index_z(src, z2b_func, &data);,
+		km_smat_each_with_index_i(src, i2b_func, &data);,
+		rb_raise(km_eInternal, "unexpected reach");,
+		km_smat_each_with_index_v(src, v2b_func, &data);
+	);
+	return ret;
+}
+
+static void
+d2v_func(double *ent, int i, int j, void *data_)
+{
+	struct km_conv_arg *data = (struct km_conv_arg *)data_;
+	(data->vbody)[i+j*(data->ldb)] = rb_float_new(*ent);
+}
+static void
+z2v_func(COMPLEX *ent, int i, int j, void *data_)
+{
+	struct km_conv_arg *data = (struct km_conv_arg *)data_;
+	(data->vbody)[i+j*(data->ldb)] = km_c2v(*ent);
+}
+static void
+i2v_func(int *ent, int i, int j, void *data_)
+{
+	struct km_conv_arg *data = (struct km_conv_arg *)data_;
+	(data->vbody)[i+j*(data->ldb)] = INT2NUM(*ent);
+}
+static void
+b2v_func(bool *ent, int i, int j, void *data_)
+{
+	struct km_conv_arg *data = (struct km_conv_arg *)data_;
+	(data->vbody)[i+j*(data->ldb)] = TF2V(*ent);
+}
+VALUE
+kmm_mat_to_omat_destl(VALUE self)
+{
+	km_check_frozen(self);
+	SMAT *src = km_mat2smat(self);
+	if ( src->vtype == VT_VALUE ) {
+		return self;
+	}
+	SMAT *dest = km_smat_alloc(src->m, src->n, VT_VALUE);
+	struct km_conv_arg data = {{dest->body}, dest->ld};
+	VT_SWITCH( src->vtype,
+		km_smat_each_with_index_d(src, d2v_func, &data);,
+		km_smat_each_with_index_z(src, z2v_func, &data);,
+		km_smat_each_with_index_i(src, i2v_func, &data);,
+		km_smat_each_with_index_b(src, b2v_func, &data);,
+		rb_raise(km_eInternal, "unexpected reach");
+	);
+	km_smat_copy(src, dest);
+	return self;
+}
+VALUE
+kmm_mat_to_omat(VALUE self)
+{
+	km_check_frozen(self);
+	SMAT *src = km_mat2smat(self);
+	if ( src->vtype == VT_VALUE ) {
+		return rb_funcall(self, id_dup, 0);
+	}
+	VALUE ret = km_Mat(src->m, src->n, VT_VALUE);
+	SMAT *dest = km_mat2smat(ret);
+	struct km_conv_arg data = {{dest->body}, dest->ld};
+	VT_SWITCH( src->vtype,
+		km_smat_each_with_index_d(src, d2v_func, &data);,
+		km_smat_each_with_index_z(src, z2v_func, &data);,
+		km_smat_each_with_index_i(src, i2v_func, &data);,
+		km_smat_each_with_index_b(src, b2v_func, &data);,
+		rb_raise(km_eInternal, "unexpected reach");
+	);
+	return ret;
+}

data/ext/kmat/smat/elem.c

@@ -0,0 +1,171 @@
+#include "../kmat.h"
+
+// returns sizeof values of the elements with value type `vt'
+size_t
+km_sizeof_vt(VTYPE vt)
+{
+	VT_SWITCH( vt,
+		return sizeof(double);,
+		return sizeof(COMPLEX);,
+		return sizeof(int);,
+		return sizeof(bool);,
+		return sizeof(VALUE);
+	);
+}
+
+// replace the body of `dest' by complex values with real parts `real' and imaginary parts `imag'
+static void
+km_smat_complex_func(COMPLEX *ed, const double *er, const double *ei, void *null)
+{
+	*ed = cpack(*er, *ei);
+}
+
+void
+km_smat_complex(SMAT *dest, const SMAT *real, const SMAT *imag)
+{
+	if ( dest->vtype != VT_COMPLEX || real->vtype != VT_DOUBLE || imag->vtype != VT_DOUBLE ) {
+		rb_raise(km_eVT, "unmatched value type");
+	}
+	CHECK_SAME_SIZE(dest, real);
+	CHECK_SAME_SIZE(dest, imag);
+	dest->trans = false;
+	km_smat_each3_zcdcd(dest, real, imag, km_smat_complex_func, NULL);
+}
+
+// returns value type from a Symbol `vsym'
+VTYPE
+km_sym2vt(VALUE vsym)
+{
+	if ( rb_respond_to(vsym, id_to_sym) ) {
+		vsym = rb_funcall(vsym, id_to_sym, 0);
+	}
+	if ( vsym == sym_float || vsym == sym_f || vsym == sym_double || vsym == sym_d ) {
+		return VT_DOUBLE;
+	} else if ( vsym == sym_complex || vsym == sym_c || vsym == sym_z ) {
+		return VT_COMPLEX;
+	} else if ( vsym == sym_int || vsym == sym_integer || vsym == sym_i ) {
+		return VT_INT;
+	} else if ( vsym == sym_bool || vsym == sym_boolean || vsym == sym_b ) {
+		return VT_BOOL;
+	} else if ( vsym == sym_object || vsym == sym_o || vsym == sym_value || vsym == sym_v ) {
+		return VT_VALUE;
+	} else {
+		rb_raise(rb_eArgError, "unknown value type");
+	}
+}
+
+// convert ruby-object `obj' to COMPLEX value in C
+COMPLEX
+km_v2c(VALUE obj)
+{
+	VALUE c_obj = rb_funcall(obj, id_to_c, 0);
+	double x = NUM2DBL(rb_funcall(c_obj, id_real, 0));
+	double y = NUM2DBL(rb_funcall(c_obj, id_imag, 0));
+	return cpack(x, y);
+}
+
+// convert COMPLEX value `c' in C to an instance of Complex in Ruby
+VALUE
+km_c2v(COMPLEX c)
+{
+	return rb_complex_new(rb_float_new(creal(c)), rb_float_new(cimag(c)));
+}
+
+VALUE
+kmm_mat_row_size(VALUE self)
+{
+	return INT2NUM(km_mat2smat(self)->m);
+}
+
+// alias column_size
+VALUE
+kmm_mat_col_size(VALUE self)
+{
+	return INT2NUM(km_mat2smat(self)->n);
+}
+
+VALUE
+kmm_mat_length(VALUE self)
+{
+	return INT2NUM(LENGTH(km_mat2smat(self)));
+}
+
+// alias size
+VALUE
+kmm_mat_shape(VALUE self)
+{
+	SMAT *smat = km_mat2smat(self);
+	return rb_ary_new3(2, INT2NUM(smat->m), INT2NUM(smat->n));
+}
+
+VALUE
+kmm_mat_vtype(VALUE self)
+{
+	return km_vt2sym(km_mat2smat(self)->vtype);
+}
+
+VALUE
+km_vt2sym(VTYPE vt)
+{
+	VT_SWITCH( vt,
+		return sym_float;,
+		return sym_complex;,
+		return sym_int;,
+		return sym_bool;,
+		return sym_object;
+	);
+}
+
+VALUE
+kmm_Mat_vt_refine(VALUE klass, VALUE vsym)
+{
+	VTYPE vt = km_sym2vt(vsym);
+	VT_SWITCH( vt,
+		return sym_float;,
+		return sym_complex;,
+		return sym_int;,
+		return sym_bool;,
+		return sym_object;
+	);
+}
+
+// transform the value type of `self' by a Symbol vsym
+// alias vtype=
+VALUE
+kmm_mat_set_vtype(VALUE self, VALUE vsym)
+{
+	VT_SWITCH( km_sym2vt(vsym),
+		return kmm_mat_to_fmat_destl(self);,
+		return kmm_mat_to_cmat_destl(self);,
+		return kmm_mat_to_imat_destl(self);,
+		return kmm_mat_to_bmat_destl(self);,
+		return kmm_mat_to_omat_destl(self);
+	);
+}
+
+VALUE
+kmm_mat_stype(VALUE self)
+{
+	STYPE st = km_mat2smat(self)->stype;
+	if ( st == ST_FULL ) {
+		return sym_full;
+	} else if ( st == ST_SSUB ) {
+		return sym_serial;
+	} else if ( st == ST_RSUB ) {
+		return sym_random;
+	} else {
+		rb_raise(km_eInternal, "unknown storage type");
+	}
+}
+
+VALUE
+kmm_mat_vector_p(VALUE self)
+{
+	return TF2V(VECTOR_P(km_mat2smat(self)));
+}
+VALUE
+kmm_mat_square_p(VALUE self)
+{
+	SMAT *smat = km_mat2smat(self);
+	return TF2V(smat->m==smat->n);
+}