static VALUE rb_gsl_spline_init(VALUE obj, VALUE xxa, VALUE yya)
{
rb_gsl_spline *sp = NULL;
gsl_spline *p = NULL;
gsl_vector *xa = NULL, *ya = NULL;
size_t i, size;
int flagx = 0, flagy = 0;
double *ptr1 = NULL, *ptr2 = NULL;
#ifdef HAVE_NARRAY_H
struct NARRAY *nax = NULL, *nay = NULL;
#endif
Data_Get_Struct(obj, rb_gsl_spline, sp);
p = sp->s;
if (TYPE(xxa) == T_ARRAY) {
size = RARRAY_LEN(xxa);
xa = gsl_vector_alloc(size);
for (i = 0; i < size; i++) gsl_vector_set(xa, i, NUM2DBL(rb_ary_entry(xxa, i)));
ptr1 = xa->data;
flagx = 1;
} else if (VECTOR_P(xxa)) {
Data_Get_Struct(xxa, gsl_vector, xa);
size = xa->size;
ptr1 = xa->data;
#ifdef HAVE_NARRAY_H
} else if (NA_IsNArray(xxa)) {
GetNArray(xxa, nax);
size = nax->total;
ptr1 = (double *) nax->ptr;
#endif
} else {
rb_raise(rb_eTypeError, "not a vector");
}
if (TYPE(yya) == T_ARRAY) {
ya = gsl_vector_alloc(size);
for (i = 0; i < size; i++) gsl_vector_set(ya, i, NUM2DBL(rb_ary_entry(yya, i)));
ptr2 = ya->data;
flagy = 1;
#ifdef HAVE_NARRAY_H
} else if (NA_IsNArray(yya)) {
GetNArray(yya, nay);
ptr2 = (double *) nay->ptr;
#endif
} else if (VECTOR_P(yya)) {
Data_Get_Struct(yya, gsl_vector, ya);
ptr2 = ya->data;
} else {
rb_raise(rb_eTypeError, "not a vector");
}
gsl_spline_init(p, ptr1, ptr2, size);
if (flagx == 1) gsl_vector_free(xa);
if (flagy == 1) gsl_vector_free(ya);
return obj;
}
double* get_ptr_double3(VALUE obj, size_t *size, size_t *stride, int *flag)
{
gsl_vector *v;
#ifdef HAVE_NARRAY_H
double *ptr;
struct NARRAY *na;
if (NA_IsNArray(obj)) {
obj = na_change_type(obj, NA_DFLOAT);
GetNArray(obj, na);
ptr = (double *) na->ptr;
*size = na->total;
*stride = 1;
*flag = 1;
return ptr;
}
#endif
CHECK_VECTOR(obj);
Data_Get_Struct(obj, gsl_vector, v);
*size = v->size;
*stride = v->stride;
*flag = 0;
return v->data;
}
static VALUE rb_gsl_wavelet_transform0(int argc, VALUE *argv, VALUE obj,
int sss)
{
gsl_wavelet *w = NULL;
gsl_vector *v = NULL, *vnew;
gsl_wavelet_direction dir = forward;
gsl_wavelet_workspace *work = NULL;
int itmp, flag = 0;
// local variable "status" declared and set, but never used
//int status;
double *ptr1, *ptr2;
size_t n, stride;
int naflag = 0;
VALUE ary, ret;
#ifdef HAVE_NARRAY_H
struct NARRAY *na1 = NULL;
#endif
switch (TYPE(obj)) {
case T_MODULE:
case T_CLASS:
case T_OBJECT:
if (argc < 2) rb_raise(rb_eArgError, "too few arguments");
CHECK_WAVELET(argv[0]);
if (MATRIX_P(argv[1])) {
return rb_gsl_wavelet2d(argc, argv, obj,
gsl_wavelet2d_transform_matrix, sss);
}
if (VECTOR_P(argv[1])) {
Data_Get_Struct(argv[0], gsl_wavelet, w);
Data_Get_Struct(argv[1], gsl_vector, v);
ret = argv[1];
ptr1 = v->data;
n = v->size;
stride = v->stride;
#ifdef HAVE_NARRAY_H
} else if (NA_IsNArray(argv[1])) {
GetNArray(argv[1], na1);
ret = argv[1];
ptr1 = (double*) na1->ptr;
n = na1->total;
naflag = 1;
stride = 1;
#endif
} else {
rb_raise(rb_eTypeError, "wrong argument type (Vector expected)");
}
itmp = 2;
break;
default:
if (argc < 1) rb_raise(rb_eArgError, "too few arguments");
if (MATRIX_P(argv[0])) {
return rb_gsl_wavelet2d(argc, argv, obj,
gsl_wavelet2d_transform_matrix, sss);
}
if (VECTOR_P(obj)) {
CHECK_WAVELET(argv[0]);
Data_Get_Struct(argv[0], gsl_wavelet, w);
Data_Get_Struct(obj, gsl_vector, v);
ret = obj;
ptr1 = v->data;
n = v->size;
stride = v->stride;
} else if (VECTOR_P(argv[0])) {
CHECK_WAVELET(obj);
Data_Get_Struct(obj, gsl_wavelet, w);
Data_Get_Struct(argv[0], gsl_vector, v);
ret = argv[0];
ptr1 = v->data;
n = v->size;
stride = v->stride;
#ifdef HAVE_NARRAY_H
} else if (NA_IsNArray(obj)) {
CHECK_WAVELET(argv[0]);
Data_Get_Struct(argv[0], gsl_wavelet, w);
GetNArray(obj, na1);
ret = obj;
ptr1 = (double*) na1->ptr;
n = na1->total;
naflag = 1;
stride = 1;
} else if (NA_IsNArray(argv[0])) {
CHECK_WAVELET(obj);
Data_Get_Struct(obj, gsl_wavelet, w);
GetNArray(argv[0], na1);
ret = argv[0];
ptr1 = (double*) na1->ptr;
n = na1->total;
naflag = 1;
stride = 1;
#endif
} else {
rb_raise(rb_eTypeError, "wrong argument type");
}
itmp = 1;
break;
}
switch (argc - itmp) {
case 2:
CHECK_FIXNUM(argv[itmp]);
CHECK_WORKSPACE(argv[itmp+1]);
dir = FIX2INT(argv[itmp]);
Data_Get_Struct(argv[itmp+1], gsl_wavelet_workspace, work);
break;
case 1:
if (TYPE(argv[itmp]) == T_FIXNUM) {
dir = FIX2INT(argv[itmp]);
work = gsl_wavelet_workspace_alloc(v->size);
flag = 1;
} else if (rb_obj_is_kind_of(argv[itmp], cgsl_wavelet_workspace)) {
Data_Get_Struct(argv[itmp], gsl_wavelet_workspace, work);
} else {
rb_raise(rb_eTypeError, "wrong argument type");
}
break;
case 0:
work = gsl_wavelet_workspace_alloc(v->size);
flag = 1;
break;
default:
rb_raise(rb_eArgError, "too many arguments");
break;
}
if (naflag == 0) {
if (sss == RB_GSL_DWT_COPY) {
vnew = gsl_vector_alloc(v->size);
gsl_vector_memcpy(vnew, v);
ary = Data_Wrap_Struct(cgsl_vector, 0, gsl_vector_free, vnew);
ptr2 = vnew->data;
} else {
ary = ret;
ptr2 = ptr1;
}
} else {
#ifdef HAVE_NARRAY_H
if (sss == RB_GSL_DWT_COPY) {
ary = na_make_object(NA_DFLOAT, na1->rank, na1->shape, cNArray);
ptr2 = NA_PTR_TYPE(ary, double*);
memcpy(ptr2, ptr1, sizeof(double)*n);
} else {
// Analyze *a* which is *i*-th index object and store the information to q
//
// a: a ruby object of i-th index
// size: size of i-th dimension of original NArray
// i: parse i-th index
// q: parsed information is stored to *q
static void
na_index_parse_each(volatile VALUE a, ssize_t size, int i, na_index_arg_t *q)
{
switch(TYPE(a)) {
case T_FIXNUM:
na_index_set_scalar(q,i,size,FIX2LONG(a));
break;
case T_BIGNUM:
na_index_set_scalar(q,i,size,NUM2SSIZET(a));
break;
case T_FLOAT:
na_index_set_scalar(q,i,size,NUM2SSIZET(a));
break;
case T_NIL:
case T_TRUE:
na_index_set_step(q,i,size,0,1);
break;
case T_SYMBOL:
if (a==sym_all || a==sym_ast) {
na_index_set_step(q,i,size,0,1);
}
else if (a==sym_reverse) {
na_index_set_step(q,i,size,size-1,-1);
}
else if (a==sym_new) {
na_index_set_step(q,i,1,0,1);
}
else if (a==sym_reduce || a==sym_sum || a==sym_plus) {
na_index_set_step(q,i,size,0,1);
q->reduce = 1;
} else {
rb_raise(rb_eIndexError, "invalid symbol for index");
}
break;
case T_ARRAY:
na_parse_array(a, i, size, q);
break;
default:
if (rb_obj_is_kind_of(a, rb_cRange)) {
na_parse_range(a, 1, i, size, q);
}
else if (rb_obj_is_kind_of(a, rb_cEnumerator)) {
na_parse_enumerator(a, i, size, q);
}
else if (rb_obj_is_kind_of(a, na_cStep)) {
ssize_t beg, step, n;
nary_step_array_index(a, size, (size_t*)(&n), &beg, &step);
na_index_set_step(q,i,n,beg,step);
}
// NArray index
else if (NA_IsNArray(a)) {
na_parse_narray_index(a, i, size, q);
}
else {
rb_raise(rb_eIndexError, "not allowed type");
}
}
}
