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 int get_vector_complex2(int argc, VALUE *argv, VALUE obj,
gsl_vector_complex **x, gsl_vector_complex **y)
{
int flag = 0;
switch (TYPE(obj)) {
case T_MODULE:
case T_CLASS:
case T_OBJECT:
if (argc != 2) rb_raise(rb_eArgError, "wrong number of arguments (%d for 2)",
argc);
CHECK_VECTOR_COMPLEX(argv[0]);
CHECK_VECTOR_COMPLEX(argv[1]);
Data_Get_Struct(argv[0], gsl_vector_complex, (*x));
Data_Get_Struct(argv[1], gsl_vector_complex, (*y));
break;
default:
if (argc != 1) rb_raise(rb_eArgError, "wrong number of arguments (%d for 1)",
argc);
CHECK_VECTOR_COMPLEX(argv[0]);
Data_Get_Struct(obj, gsl_vector_complex, (*x));
Data_Get_Struct(argv[0], gsl_vector_complex, (*y));
flag = 1;
break;
}
return flag;
}
static VALUE rb_gsl_linalg_complex_householder_hv(VALUE obj, VALUE t, VALUE vv, VALUE ww)
{
gsl_vector_complex *v = NULL, *w = NULL;
gsl_complex *tau;
CHECK_COMPLEX(t);
CHECK_VECTOR_COMPLEX(vv);
CHECK_VECTOR_COMPLEX(ww);
Data_Get_Struct(t, gsl_complex, tau);
Data_Get_Struct(vv, gsl_vector_complex, v);
Data_Get_Struct(ww, gsl_vector_complex, w);
gsl_linalg_complex_householder_hv(*tau, v, w);
return ww;
}
static VALUE rb_gsl_linalg_cholesky_svx(int argc, VALUE *argv, VALUE obj)
{
gsl_matrix_complex *A = NULL, *Atmp = NULL;
gsl_vector_complex *b = NULL;
int flaga = 0;
VALUE vA, vb;
switch(TYPE(obj)) {
case T_MODULE: case T_CLASS: case T_OBJECT:
if (argc != 2) rb_raise(rb_eArgError, "wrong number of argument (%d for 2)",
argc);
vA = argv[0];
vb = argv[1];
break;
default:
if (argc != 1) rb_raise(rb_eArgError, "wrong number of argument (%d for 1)",
argc);
vA = obj;
vb = argv[0];
break;
}
CHECK_MATRIX_COMPLEX(vA);
Data_Get_Struct(vA, gsl_matrix_complex, Atmp);
CHECK_VECTOR_COMPLEX(vb);
Data_Get_Struct(vb, gsl_vector_complex, b);
if (CLASS_OF(vA) == cgsl_matrix_complex_C) {
A = Atmp;
} else {
A = make_matrix_complex_clone(Atmp);
flaga = 1;
gsl_linalg_complex_cholesky_decomp(A);
}
gsl_linalg_complex_cholesky_svx(A, b);
if (flaga == 1) gsl_matrix_complex_free(A);
return vb;
}
static VALUE rb_gsl_blas_zscal2(int argc, VALUE *argv, VALUE obj)
{
gsl_complex *a = NULL;
gsl_vector_complex *x = NULL, *xnew = NULL;
CHECK_COMPLEX(argv[0]);
switch (TYPE(obj)) {
case T_MODULE:
case T_CLASS:
case T_OBJECT:
if (argc != 2) rb_raise(rb_eArgError, "wrong number of arguments (%d for 2)",
argc);
CHECK_VECTOR_COMPLEX(argv[1]);
Data_Get_Struct(argv[0], gsl_complex, a);
Data_Get_Struct(argv[1], gsl_vector_complex, x);
break;
default:
if (argc != 1) rb_raise(rb_eArgError, "wrong number of arguments (%d for 1)",
argc);
Data_Get_Struct(obj, gsl_vector_complex, x);
Data_Get_Struct(argv[0], gsl_complex, a);
break;
}
xnew = gsl_vector_complex_alloc(x->size);
gsl_vector_complex_memcpy(xnew, x);
gsl_blas_zscal(*a, xnew);
return Data_Wrap_Struct(cgsl_vector_complex, 0, gsl_vector_complex_free, xnew);
}
static VALUE rb_gsl_blas_zscal(int argc, VALUE *argv, VALUE obj)
{
gsl_complex *a = NULL;
gsl_vector_complex *x = NULL;
CHECK_COMPLEX(argv[0]);
switch (TYPE(obj)) {
case T_MODULE:
case T_CLASS:
case T_OBJECT:
if (argc != 2) rb_raise(rb_eArgError, "wrong number of arguments (%d for 2)",
argc);
CHECK_VECTOR_COMPLEX(argv[1]);
Data_Get_Struct(argv[0], gsl_complex, a);
Data_Get_Struct(argv[1], gsl_vector_complex, x);
gsl_blas_zscal(*a, x);
return argv[1];
break;
default:
if (argc != 1) rb_raise(rb_eArgError, "wrong number of arguments (%d for 1)",
argc);
Data_Get_Struct(obj, gsl_vector_complex, x);
Data_Get_Struct(argv[0], gsl_complex, a);
gsl_blas_zscal(*a, x);
return obj;
break;
}
}
static VALUE rb_gsl_blas_zdscal(int argc, VALUE *argv, VALUE obj)
{
double a;
gsl_vector_complex *x = NULL;
switch (TYPE(obj)) {
case T_MODULE:
case T_CLASS:
case T_OBJECT:
if (argc != 2) rb_raise(rb_eArgError, "wrong number of arguments (%d for 2)",
argc);
Need_Float(argv[0]);
CHECK_VECTOR_COMPLEX(argv[1]);
// a = RFLOAT(argv[0])->value;
a = NUM2DBL(argv[0]);
Data_Get_Struct(argv[1], gsl_vector_complex, x);
gsl_blas_zdscal(a, x);
return argv[1];
break;
default:
Data_Get_Struct(obj, gsl_vector_complex, x);
if (argc != 1) rb_raise(rb_eArgError, "wrong number of arguments (%d for 1)",
argc);
Need_Float(argv[0]);
a = NUM2DBL(argv[0]);
gsl_blas_zdscal(a, x);
return obj;
break;
}
}
static VALUE rb_gsl_blas_zaxpy2(int argc, VALUE *argv, VALUE obj)
{
gsl_complex *a = NULL;
gsl_vector_complex *x = NULL, *y = NULL, *y2 = NULL;
switch (TYPE(obj)) {
case T_MODULE:
case T_CLASS:
case T_OBJECT:
get_vector_complex2(argc-1, argv+1, obj, &x, &y);
CHECK_COMPLEX(argv[0]);
Data_Get_Struct(argv[0], gsl_complex, a);
break;
default:
Data_Get_Struct(obj, gsl_vector_complex, x);
if (argc != 2) rb_raise(rb_eArgError, "wrong number of arguments (%d for 2)",
argc);
CHECK_COMPLEX(argv[0]);
CHECK_VECTOR_COMPLEX(argv[1]);
Data_Get_Struct(argv[0], gsl_complex, a);
Data_Get_Struct(argv[1], gsl_vector_complex, y);
break;
}
y2 = gsl_vector_complex_alloc(y->size);
gsl_vector_complex_memcpy(y2, y);
gsl_blas_zaxpy(*a, x, y2);
return Data_Wrap_Struct(cgsl_vector_complex, 0, gsl_vector_complex_free, y2);
}
static VALUE rb_gsl_linalg_complex_householder_mh(VALUE obj, VALUE t, VALUE vv, VALUE aa)
{
gsl_vector_complex *v = NULL;
gsl_complex *tau;
gsl_matrix_complex *A = NULL;
CHECK_COMPLEX(t);
CHECK_VECTOR_COMPLEX(vv);
CHECK_MATRIX_COMPLEX(aa);
Data_Get_Struct(t, gsl_complex, tau);
Data_Get_Struct(vv, gsl_vector_complex, v);
Data_Get_Struct(aa, gsl_matrix_complex, A);
gsl_linalg_complex_householder_hm(*tau, v, A);
return aa;
}
// Parse argc, argv. obj must be GSL::Vector::Complex.
// This can be simplified at some point.
// See comments preceding get_complex_stride_n()
static int gsl_fft_get_argv_complex(int argc, VALUE *argv, VALUE obj,
gsl_vector_complex ** vin,
gsl_complex_packed_array *data, size_t *stride,
size_t *n, gsl_fft_complex_wavetable **table,
gsl_fft_complex_workspace **space)
{
int flag = NONE_OF_TWO, flagtmp, i, itmp = argc, itmp2 = 0, ccc;
int flagw = 0;
CHECK_VECTOR_COMPLEX(obj);
ccc = argc;
flagtmp = 0;
flagw = 0;
for (i = argc-1; i >= itmp2; i--) {
if (rb_obj_is_kind_of(argv[i], cgsl_fft_complex_workspace)) {
Data_Get_Struct(argv[i], gsl_fft_complex_workspace, *space);
flagtmp = 1;
flagw = 1;
itmp = i;
ccc--;
break;
}
}
flagtmp = 0;
for (i = itmp-1; i >= itmp2; i--) {
if (rb_obj_is_kind_of(argv[i], cgsl_fft_complex_wavetable)) {
Data_Get_Struct(argv[i], gsl_fft_complex_wavetable, *table);
flagtmp = 1;
ccc--;
break;
}
}
get_complex_stride_n(obj, vin, data, stride, n);
if (flagw == 0) {
*space = gsl_fft_complex_workspace_alloc(*n);
flag += ALLOC_SPACE;
}
if (flagtmp == 0) {
*table = gsl_fft_complex_wavetable_alloc(*n);
flag += ALLOC_TABLE;
}
if (*table == NULL) {
rb_raise(rb_eRuntimeError, "something wrong with wavetable");
}
if (*space == NULL) {
rb_raise(rb_eRuntimeError, "something wrong with workspace");
}
return flag;
}
// The FFT methods used to allow passing stride and n values as optional
// parameters to control which elements get transformed. This created problems
// for Views which can have their own stride, so support for stride and n
// parameters to the transform methods is being dropped. This method used to
// be called to determine the stride and n values to use based on the
// parameters and/or the vector itself (depending on how many parameters were
// passed). Now this function is somewhat unneceesary, but to simplify the code
// refactoring, it has been left in place for the time being. Eventually it
// can be refactored away completely.
static VALUE get_complex_stride_n(VALUE obj,
gsl_vector_complex **vin,
gsl_complex_packed_array *data, size_t *stride, size_t *n)
{
gsl_vector_complex *v = NULL;
// obj must be a GSL::Vector::Complex
CHECK_VECTOR_COMPLEX(obj);
Data_Get_Struct(obj, gsl_vector_complex, v);
if(vin) *vin = v;
*data = (gsl_complex_packed_array) v->data;
*stride = v->stride;
*n = v->size;
return obj;
}
static VALUE rb_gsl_linalg_complex_householder_transform(int argc, VALUE *argv, VALUE obj)
{
gsl_vector_complex *v = NULL;
gsl_complex *z;
switch (TYPE(obj)) {
case T_MODULE: case T_CLASS: case T_OBJECT:
if (argc < 1) rb_raise(rb_eArgError, "too few arguments.");
CHECK_VECTOR_COMPLEX(argv[0]);
Data_Get_Struct(argv[0], gsl_vector_complex, v);
break;
default:
Data_Get_Struct(obj, gsl_vector_complex, v);
break;
}
z = (gsl_complex*) malloc(sizeof(gsl_complex));
*z = gsl_linalg_complex_householder_transform(v);
return Data_Wrap_Struct(cgsl_complex, 0, free, z);
}
