/* singleton */
static VALUE rb_gsl_permutation_memcpy(VALUE obj, VALUE pp1, VALUE pp2)
{
gsl_permutation *p1, *p2 = NULL;
CHECK_PERMUTATION(pp1);
CHECK_PERMUTATION(pp2);
Data_Get_Struct(pp1, gsl_permutation, p1);
Data_Get_Struct(pp2, gsl_permutation, p2);
gsl_permutation_memcpy(p1, p2);
return pp1;
}
static VALUE rb_gsl_linalg_complex_LU_refine(VALUE obj, VALUE vm,
VALUE lu, VALUE pp, VALUE bb,
VALUE xx)
{
gsl_matrix_complex *m = NULL, *mlu = NULL;
gsl_permutation *p = NULL;
gsl_vector_complex *b = NULL, *x = NULL, *r = NULL;
int flagb = 0;
VALUE vr;
if (CLASS_OF(obj) != cgsl_matrix_complex_LU)
rb_raise(rb_eRuntimeError, "Decompose first!");
CHECK_MATRIX_COMPLEX(vm);
CHECK_MATRIX_COMPLEX(lu);
CHECK_PERMUTATION(pp);
CHECK_VECTOR_COMPLEX(xx);
Data_Get_Struct(vm, gsl_matrix_complex, m);
Data_Get_Struct(lu, gsl_matrix_complex, mlu);
Data_Get_Struct(pp, gsl_permutation, p);
CHECK_VECTOR_COMPLEX(bb);
Data_Get_Struct(bb, gsl_vector_complex, b);
Data_Get_Struct(xx, gsl_vector_complex, x);
r = gsl_vector_complex_alloc(m->size1);
gsl_linalg_complex_LU_refine(m, mlu, p, b, x, r);
vr = Data_Wrap_Struct(cgsl_vector_complex, 0, gsl_vector_complex_free, r);
if (flagb == 1) gsl_vector_complex_free(b);
return rb_ary_new3(2, xx, vr);
}
static VALUE rb_gsl_permutation_mul(VALUE obj, VALUE ppa, VALUE ppb)
{
gsl_permutation *p = NULL;
gsl_permutation *pa = NULL, *pb = NULL;
int flag = 0;
CHECK_PERMUTATION(ppa);
CHECK_PERMUTATION(ppb);
Data_Get_Struct(ppa, gsl_permutation, pa);
Data_Get_Struct(ppb, gsl_permutation, pb);
if (rb_obj_is_kind_of(obj, cgsl_permutation)) {
Data_Get_Struct(obj, gsl_permutation, p);
flag = 1;
} else {
p = gsl_permutation_alloc(pa->size);
}
gsl_permutation_mul(p, pa, pb);
if (flag == 1) return obj;
else return Data_Wrap_Struct(cgsl_permutation, 0, gsl_permutation_free, p);
}
static VALUE rb_gsl_vector_permute_inverse(VALUE obj, VALUE pp)
{
gsl_permutation *p = NULL;
gsl_vector *v = NULL;
int status;
CHECK_PERMUTATION(pp);
Data_Get_Struct(pp, gsl_permutation, p);
Data_Get_Struct(obj, gsl_vector, v);
status = gsl_permute_vector_inverse(p, v);
return INT2FIX(status);
}
static VALUE rb_gsl_permutation_equal(VALUE obj, VALUE other)
{
gsl_permutation *p1 = NULL, *p2 = NULL;
size_t i;
CHECK_PERMUTATION(other);
Data_Get_Struct(obj, gsl_permutation, p1);
Data_Get_Struct(other, gsl_permutation, p2);
if (p1->size != p2->size) return Qfalse;
for (i = 0; i < p1->size; i++)
if (p1->data[i] != p2->data[i]) return Qfalse;
return Qtrue;
}
VALUE rb_gsl_linalg_complex_LU_decomp(int argc, VALUE *argv, VALUE obj)
{
gsl_matrix_complex *m = NULL;
gsl_permutation *p = NULL;
int signum, itmp;
size_t size;
VALUE obj2;
switch (TYPE(obj)) {
case T_MODULE:
case T_CLASS:
case T_OBJECT:
if (argc != 1) rb_raise(rb_eArgError, "wrong number of arguments (%d for 1)",
argc);
CHECK_MATRIX_COMPLEX(argv[0]);
Data_Get_Struct(argv[0], gsl_matrix_complex, m);
itmp = 1;
break;
default:
CHECK_MATRIX_COMPLEX(obj);
Data_Get_Struct(obj, gsl_matrix_complex, m);
itmp = 0;
}
size = m->size1;
switch (argc-itmp) {
case 0:
p = gsl_permutation_alloc(size);
gsl_linalg_complex_LU_decomp(m, p, &signum);
if (itmp == 1) rb_obj_reveal(argv[0], cgsl_matrix_complex_LU);
else rb_obj_reveal(obj, cgsl_matrix_complex_LU);
obj2 = Data_Wrap_Struct(cgsl_permutation, 0, gsl_permutation_free, p);
return rb_ary_new3(2, obj2, INT2FIX(signum));
break;
case 1: /* when a permutation object is given */
CHECK_PERMUTATION(argv[itmp]);
Data_Get_Struct(argv[itmp], gsl_permutation, p);
gsl_linalg_complex_LU_decomp(m, p, &signum);
if (itmp == 1) rb_obj_reveal(argv[0], cgsl_matrix_complex_LU);
else rb_obj_reveal(obj, cgsl_matrix_complex_LU);
return INT2FIX(signum);
break;
default:
rb_raise(rb_eArgError, "Usage: LU_decomp!() or LU_decomp!(permutation)");
}
}
static VALUE rb_gsl_permutation_canonical_to_linear(int argc, VALUE *argv, VALUE obj)
{
gsl_permutation *p, *q;
Data_Get_Struct(obj, gsl_permutation, p);
switch (argc) {
case 0:
q = gsl_permutation_alloc(p->size);
gsl_permutation_canonical_to_linear(q, p);
return Data_Wrap_Struct(cgsl_permutation, 0, gsl_permutation_free, q);
break;
case 1:
CHECK_PERMUTATION(argv[0]);
Data_Get_Struct(argv[0], gsl_permutation, q);
gsl_permutation_canonical_to_linear(q, p);
return obj;
break;
default:
rb_raise(rb_eArgError, "wrong number of arguments (%d for 1)", argc);
}
return Qtrue;
}
