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"); } } }