kmat 0.0.3

data/ext/kmat/smat/array.c

@@ -0,0 +1,108 @@
+#include "../kmat.h"
+
+static VALUE
+km_block(VALUE idx, VALUE ary, VALUE self)
+{
+	VALUE row = rb_ary_entry(ary, NUM2LONG(rb_ary_entry(idx, 0)));
+	return rb_ary_entry(row, NUM2LONG(rb_ary_entry(idx, 1)));
+}
+static VALUE
+km_block_vector(VALUE idx, VALUE ary, VALUE self)
+{
+	return rb_ary_entry(ary, NUM2LONG(rb_ary_entry(idx, 0)));
+}
+static long
+km_check_col_size(VALUE ary)
+{
+	long ret = RARRAY_LEN(rb_ary_entry(ary, 0));
+	for ( long i=1; i<RARRAY_LEN(ary); i++ ) {
+		if ( RARRAY_LEN(rb_ary_entry(ary, i)) != ret ) {
+			rb_raise(km_eDim, "the length of rows must be the same");
+		}
+	}
+	return ret;
+}
+
+VALUE
+kmm_ary_to_fmat(VALUE self)
+{
+	if ( RARRAY_LEN(self) == 0 ) {
+		return km_Mat(0, 0, VT_DOUBLE);
+	} else if ( TYPE(rb_ary_entry(self, 0)) == T_ARRAY ) {
+		VALUE new_arg[3] = {LONG2NUM(RARRAY_LEN(self)), LONG2NUM(km_check_col_size(self)), sym_float};
+		return rb_block_call(km_cMat, id_new, 3, new_arg, km_block, self);
+	} else {
+		VALUE new_arg[3] = {LONG2NUM(RARRAY_LEN(self)), INT2NUM(1), sym_float};
+		return rb_block_call(km_cMat, id_new, 3, new_arg, km_block_vector, self);
+	}
+}
+VALUE
+kmm_ary_to_cmat(VALUE self)
+{
+	if ( RARRAY_LEN(self) == 0 ) {
+		return km_Mat(0, 0, VT_COMPLEX);
+	} else if ( TYPE(rb_ary_entry(self, 0)) == T_ARRAY ) {
+		VALUE new_arg[3] = {LONG2NUM(RARRAY_LEN(self)), LONG2NUM(km_check_col_size(self)), sym_complex};
+		return rb_block_call(km_cMat, id_new, 3, new_arg, km_block, self);
+	} else {
+		VALUE new_arg[3] = {LONG2NUM(RARRAY_LEN(self)), INT2NUM(1), sym_complex};
+		return rb_block_call(km_cMat, id_new, 3, new_arg, km_block_vector, self);
+	}
+}
+VALUE
+kmm_ary_to_imat(VALUE self)
+{
+	if ( RARRAY_LEN(self) == 0 ) {
+		return km_Mat(0, 0, VT_INT);
+	} else if ( TYPE(rb_ary_entry(self, 0)) == T_ARRAY ) {
+		VALUE new_arg[3] = {LONG2NUM(RARRAY_LEN(self)), LONG2NUM(km_check_col_size(self)), sym_int};
+		return rb_block_call(km_cMat, id_new, 3, new_arg, km_block, self);
+	} else {
+		VALUE new_arg[3] = {LONG2NUM(RARRAY_LEN(self)), INT2NUM(1), sym_int};
+		return rb_block_call(km_cMat, id_new, 3, new_arg, km_block_vector, self);
+	}
+}
+VALUE
+kmm_ary_to_bmat(VALUE self)
+{
+	if ( RARRAY_LEN(self) == 0 ) {
+		return km_Mat(0, 0, VT_BOOL);
+	} else if ( TYPE(rb_ary_entry(self, 0)) == T_ARRAY ) {
+		VALUE new_arg[3] = {LONG2NUM(RARRAY_LEN(self)), LONG2NUM(km_check_col_size(self)), sym_bool};
+		return rb_block_call(km_cMat, id_new, 3, new_arg, km_block, self);
+	} else {
+		VALUE new_arg[3] = {LONG2NUM(RARRAY_LEN(self)), INT2NUM(1), sym_bool};
+		return rb_block_call(km_cMat, id_new, 3, new_arg, km_block_vector, self);
+	}
+}
+VALUE
+kmm_ary_to_omat(VALUE self)
+{
+	if ( RARRAY_LEN(self) == 0 ) {
+		return km_Mat(0, 0, VT_VALUE);
+	} else if ( TYPE(rb_ary_entry(self, 0)) == T_ARRAY ) {
+		VALUE new_arg[3] = {LONG2NUM(RARRAY_LEN(self)), LONG2NUM(km_check_col_size(self)), sym_object};
+		return rb_block_call(km_cMat, id_new, 3, new_arg, km_block, self);
+	} else {
+		VALUE new_arg[3] = {LONG2NUM(RARRAY_LEN(self)), INT2NUM(1), sym_object};
+		return rb_block_call(km_cMat, id_new, 3, new_arg, km_block_vector, self);
+	}
+}
+
+// alias to_m
+VALUE
+kmm_ary_to_mat(int argc, VALUE *argv, VALUE self)
+{
+	rb_check_arity(argc, 0, 1);
+	if ( argc == 0 ) {
+		return kmm_ary_to_fmat(self);
+	} else {
+		VT_SWITCH( km_sym2vt(argv[0]),
+			return kmm_ary_to_fmat(self);,
+			return kmm_ary_to_cmat(self);,
+			return kmm_ary_to_imat(self);,
+			return kmm_ary_to_bmat(self);,
+			return kmm_ary_to_omat(self);
+		);
+	}
+}

data/ext/kmat/smat/boxmuller.c

@@ -0,0 +1,72 @@
+#include "../kmat.h"
+
+VALUE kmgv_mat_random;
+
+// return a random number which follows N(0, 1)
+// `random' is an instance of Random
+double
+km_rand_normal(VALUE random)
+{
+	if (RTEST(rb_ivar_get(random, id_iv_kmat_stored))) {
+		rb_ivar_set(random, id_iv_kmat_stored, Qfalse);
+		return NUM2DBL(rb_ivar_get(random, id_iv_kmat_stored_value));
+	} else {
+		rb_ivar_set(random, id_iv_kmat_stored, Qtrue);
+		double sqrt_m2_log_x = sqrt(-2.0*log1p(-NUM2DBL(rb_funcall(random, id_rand, 0))));
+		double two_pi_y = M_2PI*NUM2DBL(rb_funcall(random, id_rand, 0));
+		rb_ivar_set(random, id_iv_kmat_stored_value, rb_float_new(sqrt_m2_log_x*sin(two_pi_y)));
+		return sqrt_m2_log_x*cos(two_pi_y);
+	}
+}
+
+// replace ary[0..(len-1)] by random numbers which follow N(0, 1)
+// `random' is an instance of Random
+void
+km_fill_normal(int len, double *ary, VALUE random)
+{
+	int i;
+	double sqrt_m2_log_x, two_pi_y;
+	len--;
+	if (RTEST(rb_ivar_get(random, id_iv_kmat_stored))) {
+		ary[0] = NUM2DBL(rb_ivar_get(random, id_iv_kmat_stored_value));
+		i = 1;
+	} else {
+		i = 0;
+	}
+	for ( ; i<len; i+= 2 ) {
+		sqrt_m2_log_x = sqrt(-2.0*log1p(-NUM2DBL(rb_funcall(random, id_rand, 0))));
+		two_pi_y = M_2PI*NUM2DBL(rb_funcall(random, id_rand, 0));
+		ary[i] = sqrt_m2_log_x*cos(two_pi_y);
+		ary[i+1] = sqrt_m2_log_x*sin(two_pi_y);
+	}
+	if ( i==len ) {
+		sqrt_m2_log_x = sqrt(-2.0*log1p(-NUM2DBL(rb_funcall(random, id_rand, 0))));
+		two_pi_y = M_2PI*NUM2DBL(rb_funcall(random, id_rand, 0));
+		ary[i] = sqrt_m2_log_x*cos(two_pi_y);
+		rb_ivar_set(random, id_iv_kmat_stored, Qtrue);
+		rb_ivar_set(random, id_iv_kmat_stored_value, rb_float_new(sqrt_m2_log_x*sin(two_pi_y)));
+	} else {
+		rb_ivar_set(random, id_iv_kmat_stored, Qfalse);
+	}
+}
+
+static VALUE
+km_random_randn(int argc, VALUE *argv, VALUE random)
+{
+	rb_check_arity(argc, 0, 2);
+	if ( argc == 0 ) {
+		return rb_float_new(km_rand_normal(random));
+	} else if ( argc == 2 ) {
+		return rb_float_new(NUM2DBL(argv[0]) + km_rand_normal(random) * sqrt(NUM2DBL(argv[1])));
+	} else {
+		rb_raise(rb_eArgError, "when mean or standard deviation is specified, the other must be specified");
+	}
+}
+
+void
+km_Mat_rand_init(void)
+{
+	kmgv_mat_random = rb_const_get(rb_cRandom, id_DEFAULT);
+	rb_define_variable("$MatRandom", &kmgv_mat_random);
+	rb_define_method(rb_cRandom, "randn", km_random_randn, -1);
+}

data/ext/kmat/smat/constructer.c

@@ -0,0 +1,302 @@
+#include "../kmat.h"
+
+// alias []
+VALUE
+kmm_Mat_array_m2(VALUE self, VALUE args)
+{
+	return kmm_ary_to_fmat(args);
+}
+
+static VALUE
+km_Mat_uninitialized(int argc, VALUE *argv)
+{
+	rb_check_arity(argc, 0, 2);
+	if ( argc == 2 ) {
+		return km_Mat(NUM2INT(argv[0]), NUM2INT(argv[1]), VT_DOUBLE);
+	} else if ( argc == 1 ) {
+		return km_Mat(NUM2INT(argv[0]), 1, VT_DOUBLE);
+	} else {
+		return km_Mat(0, 0, VT_DOUBLE);
+	}
+}
+
+// alias O
+VALUE
+kmm_Mat_zeros(int argc, VALUE *argv, VALUE self)
+{
+	return km_Mat_uninitialized(argc, argv);
+}
+
+static void
+km_ones_func(double *ent, void *null)
+{
+	*ent = 1.0;
+}
+// alias J
+VALUE
+kmm_Mat_ones(int argc, VALUE *argv, VALUE self)
+{
+	VALUE ret = km_Mat_uninitialized(argc, argv);
+	SMAT *smat = km_mat2smat(ret);
+	km_smat_each_d(smat, km_ones_func, NULL);
+	return ret;
+}
+
+// make a Mat which filled the last argument
+// the value type of the return is determined by the class of the last argument
+VALUE
+kmm_Mat_fill(int argc, VALUE *argv, VALUE self)
+{
+	rb_check_arity(argc, 1, 3);
+	VTYPE vt; VALUE ret;
+	VALUE v = argv[argc-1];
+	int type = TYPE(v);
+	if ( type == T_FLOAT ) {
+		vt = VT_DOUBLE;
+	} else if ( type == T_COMPLEX ) {
+		VALUE x = rb_funcall(v, id_real, 0);
+		VALUE y = rb_funcall(v, id_imag, 0);
+		if ( ( TYPE(x) == T_FLOAT || TYPE(x) == T_FIXNUM ) && ( TYPE(y) == T_FLOAT || TYPE(y) == T_FIXNUM ) ) {
+			vt = VT_COMPLEX;
+		} else {
+			vt = VT_VALUE;
+		}
+	} else if ( type == T_FIXNUM ) {
+		vt = VT_INT;
+	} else if ( type == T_TRUE || type == T_FALSE ) {
+		vt = VT_BOOL;
+	} else {
+		vt = VT_VALUE;
+	}
+	if ( argc == 3 ) {
+		ret = km_Mat(NUM2INT(argv[0]), NUM2INT(argv[1]), vt);
+	} else if ( argc == 2 ) {
+		ret = km_Mat(NUM2INT(argv[0]), 1, vt);
+	} else {
+		ret = km_Mat(1, 1, vt);
+	}
+	return kmm_mat_fill(ret, v);
+}
+
+// return a Mat which diagonals are 1.0 and the other elements are 0.0
+VALUE
+kmm_Mat_eye(int argc, VALUE *argv, VALUE self)
+{
+	VALUE ret = kmm_Mat_zeros(argc, argv, self);
+	SMAT *smat = km_mat2smat(ret);
+	const int n = MIN(smat->m, smat->n);
+	for ( int i=0; i<n; i++ ) {
+		smat->dbody[i+i*(smat->ld)] = 1.0;
+	}
+	return ret;
+}
+
+// almost the same as Mat.eye but Mat.identity returns only square matrix
+// alias I
+VALUE
+kmm_Mat_identity(VALUE self, VALUE vn)
+{
+	const int n = NUM2INT(vn);
+	VALUE ret = km_Mat(n, n, VT_DOUBLE);
+	SMAT *smat = km_mat2smat(ret);
+	for ( int i=0; i<n; i++ ) {
+		smat->dbody[i+i*n] = 1.0;
+	}
+	return ret;
+}
+
+// make a diagonal matrix, the diagonal elements are specified by the arguments
+// if the first argument is a vector or an Array, the diagonal elements are the elements of the first argument
+// if the first argument is a matrix, the diagonal elements are the diagonal elements of the first argument
+// if the second argument `k' given, the elements are set to k-th diagonal
+VALUE
+kmm_Mat_diag(int argc, VALUE *argv, VALUE self)
+{
+	rb_check_arity(argc, 1, 2);
+	VALUE vsrc = argv[0];
+	if ( argc == 1 ) {
+		if ( rb_obj_is_kind_of(vsrc, km_cMat) ) {
+			VALUE ret;
+			SMAT *src = km_mat2smat(vsrc);
+			if ( src->vtype != VT_DOUBLE ) {
+				vsrc = kmm_mat_to_fmat(argv[0]);
+				src = km_mat2smat(vsrc);
+			}
+			if ( VECTOR_P(src) ) { // the argument is a vector
+				const int len = LENGTH(src);
+				ret = km_Mat(len, len, VT_DOUBLE);
+				SMAT *dest = km_mat2smat(ret);
+				if ( src->stype == ST_RSUB ) {
+					for ( int i=0; i<len; i++ ) {
+						dest->dbody[i+i*len] = *((src->dpbody)[i]);
+					}
+				} else {
+					for ( int i=0; i<len; i++ ) {
+						dest->dbody[i+i*len] = src->dbody[i];
+					}
+				}
+			} else { // the argument is a matrix
+				ret = km_Mat(src->m, src->n, VT_DOUBLE);
+				SMAT *dest = km_mat2smat(ret);
+				const int n = MIN(src->m, src->n);
+				if ( src->stype == ST_RSUB ) {
+					for ( int i=0; i<n; i++ ) {
+						dest->dbody[i+i*(dest->ld)] = *((src->dpbody)[i+i*(src->ld)]);
+					}
+				} else {
+					for ( int i=0; i<n; i++ ) {
+						dest->dbody[i+i*(dest->ld)] = src->dbody[i+i*(src->ld)];
+					}
+				}
+			}
+			return ret;
+		} else if ( TYPE(vsrc) == T_ARRAY ) { // the argument is an Array
+			const long len = RARRAY_LEN(argv[0]);
+			VALUE ret = km_Mat((int)len, (int)len, VT_DOUBLE);
+			double *body = km_mat2smat(ret)->dbody;
+			for ( long i=0; i<len; i++ ) {
+				body[i+i*len] = NUM2DBL(rb_ary_entry(vsrc, i));
+			}
+			return ret;
+		} else { // (1, 1)-matrix. the (0, 0)-th element is the argument
+			VALUE ret = km_Mat(1, 1, VT_DOUBLE);
+			km_mat2smat(ret)->dbody[0] = NUM2DBL(vsrc);
+			return ret;
+		}
+	} else { // k is given
+		int k = NUM2INT(argv[1]);
+		if ( rb_obj_is_kind_of(vsrc, km_cMat) ) {
+			VALUE ret;
+			SMAT *src = km_mat2smat(vsrc);
+			if ( src->vtype != VT_DOUBLE ) {
+				vsrc = kmm_mat_to_fmat(argv[0]);
+				src = km_mat2smat(vsrc);
+			}
+			if ( VECTOR_P(src) ) { // the argument is a vector
+				const int len_s = LENGTH(src);
+				const int len = len_s + ABS(k);
+				ret = km_Mat(len, len, VT_DOUBLE);
+				SMAT *dest = km_mat2smat(ret);
+				if ( 0 < k ) {
+					if ( src->stype == ST_RSUB ) {
+						for ( int i=0; i<len_s; i++ ) {
+							dest->dbody[i+(i+k)*len] = *((src->dpbody)[i]);
+						}
+					} else {
+						for ( int i=0; i<len_s; i++ ) {
+							dest->dbody[i+(i+k)*len] = src->dbody[i];
+						}
+					}
+				} else {
+					if ( src->stype == ST_RSUB ) {
+						for ( int i=0; i<len_s; i++ ) {
+							dest->dbody[(i-k)+i*len] = *((src->dpbody)[i]);
+						}
+					} else {
+						for ( int i=0; i<len_s; i++ ) {
+							dest->dbody[(i-k)+i*len] = src->dbody[i];
+						}
+					}
+				}
+			} else { // the argument is a matrix
+				ret = km_Mat(src->m, src->n, VT_DOUBLE);
+				SMAT *dest = km_mat2smat(ret);
+				int len, i_s, j_s;
+				if ( 0 < k ) {
+					if ( k < (src->n)-(src->m) ) {
+						len = src->m;
+					} else {
+						len = src->n-k;
+					}
+					i_s = 0; j_s = k;
+				} else {
+					if ( k < (src->n)-(src->m) ) {
+						len = src->m+k;
+					} else {
+						len = src->n;
+					}
+					i_s = -k; j_s = 0;
+				}
+				for ( int i=0; i<len; i++ ) {
+					dest->dbody[i_s+i+(j_s+i)*(dest->ld)] = ENTITY(src, d, i_s+i, j_s+i);
+				}
+			}
+			return ret;
+		} else if ( TYPE(vsrc) == T_ARRAY ) { // the argument is an Array
+			const long len_s = RARRAY_LEN(argv[0]);
+			int len = ((int)len_s)+ABS(k);
+			VALUE ret = km_Mat(len, len, VT_DOUBLE);
+			double *body = km_mat2smat(ret)->dbody;
+			if ( 0 < k ) {
+				for ( long i=0; i<len_s; i++ ) {
+					body[i+(i+k)*len] = NUM2DBL(rb_ary_entry(vsrc, i));
+				}
+			} else {
+				for ( long i=0; i<len_s; i++ ) {
+					body[i-k+i*len] = NUM2DBL(rb_ary_entry(vsrc, i));
+				}
+			}
+			return ret;
+		} else { // (1+abs(k), 1+abs(k))-matrix. the (0, k)-th element (0<k) or (-k, 0)-th element (k<0) is the argument
+			const int len = 1+ABS(k);
+			VALUE ret = km_Mat(len, len, VT_DOUBLE);
+			if ( 0 < k ) {
+				km_mat2smat(ret)->dbody[k*len] = NUM2DBL(vsrc);
+			} else {
+				km_mat2smat(ret)->dbody[-k] = NUM2DBL(vsrc);
+			}
+			return ret;
+		}
+	}
+}
+
+// make a vector which contains 0..(vn-1)
+VALUE
+kmm_Mat_range(VALUE self, VALUE vn)
+{
+	const int n = NUM2INT(vn);
+	VALUE ret = km_Mat(n, 1, VT_DOUBLE);
+	double *body = km_mat2smat(ret)->dbody;
+	for ( int i=0; i<n; i++ ) {
+		body[i] = (double)i;
+	}
+	return ret;
+}
+VALUE
+kmm_Mat_irange(VALUE self, VALUE vn)
+{
+	const int n = NUM2INT(vn);
+	VALUE ret = km_Mat(n, 1, VT_INT);
+	int *body = km_mat2smat(ret)->ibody;
+	for ( int i=0; i<n; i++ ) {
+		body[i] = i;
+	}
+	return ret;
+}
+
+// make a matrix which elements follows U(0, 1)
+VALUE
+kmm_Mat__rand0(VALUE self, VALUE vm, VALUE vn, VALUE random)
+{
+	VALUE ret = km_Mat(NUM2INT(vm), NUM2INT(vn), VT_DOUBLE);
+	return kmm_mat__rand0(ret, random, Qnil);
+}
+
+// make a matrix which elements follows N(0, 1)
+VALUE
+kmm_Mat__randn0(VALUE self, VALUE vm, VALUE vn, VALUE random)
+{
+	VALUE ret = km_Mat(NUM2INT(vm), NUM2INT(vn), VT_DOUBLE);
+	return kmm_mat__randn0(ret, random);
+}
+
+// make a complex matrix. the real parts are `vr' and the imaginary parts are `vi'
+VALUE
+kmm_Mat_complex(VALUE self, VALUE vr, VALUE vi)
+{
+	SMAT *real = km_mat2smat(kmm_mat_to_fmat(vr));
+	SMAT *imag = km_mat2smat(kmm_mat_to_fmat(vi));
+	VALUE ret = km_Mat(real->m, real->n, VT_COMPLEX);
+	km_smat_complex(km_mat2smat(ret), real, imag);
+	return ret;
+}