static VALUE rb_gsl_blas_ztrsm2(VALUE obj, VALUE s, VALUE u, VALUE ta, VALUE d, VALUE a, VALUE aa, VALUE bb) { gsl_matrix_complex *A = NULL, *B = NULL, *Bnew = NULL; gsl_complex *pa = NULL; CBLAS_SIDE_t Side; CBLAS_UPLO_t Uplo; CBLAS_TRANSPOSE_t TransA; CBLAS_DIAG_t Diag; CHECK_FIXNUM(s); CHECK_FIXNUM(u); CHECK_FIXNUM(ta); CHECK_FIXNUM(d); CHECK_COMPLEX(a); CHECK_MATRIX_COMPLEX(aa); CHECK_MATRIX_COMPLEX(bb); Side = FIX2INT(s); Uplo = FIX2INT(u); TransA = FIX2INT(ta); Diag = FIX2INT(d); Data_Get_Struct(a, gsl_complex, pa); Data_Get_Struct(aa, gsl_matrix_complex, A); Data_Get_Struct(bb, gsl_matrix_complex, B); Bnew = gsl_matrix_complex_alloc(B->size1, B->size2); gsl_matrix_complex_memcpy(Bnew, B); gsl_blas_ztrsm(Side, Uplo, TransA, Diag, *pa, A, Bnew); return Data_Wrap_Struct(cgsl_matrix_complex, 0, gsl_matrix_complex_free, Bnew); }
static VALUE rb_gsl_combination_calloc(VALUE klass, VALUE n, VALUE k) { gsl_combination *c = NULL; CHECK_FIXNUM(n);CHECK_FIXNUM(k); c = gsl_combination_calloc(FIX2INT(n), FIX2INT(k)); return Data_Wrap_Struct(klass, 0, gsl_combination_free, c); }
static VALUE rb_gsl_permutation_swap(VALUE obj, VALUE i, VALUE j) { gsl_permutation *p = NULL; CHECK_FIXNUM(i); CHECK_FIXNUM(j); Data_Get_Struct(obj, gsl_permutation, p); gsl_permutation_swap(p, FIX2INT(i), FIX2INT(j)); return obj; }
static VALUE rb_gsl_sf_choose_e(VALUE obj, VALUE n, VALUE m) { gsl_sf_result *rslt = NULL; VALUE v; CHECK_FIXNUM(n); CHECK_FIXNUM(m); v = Data_Make_Struct(cgsl_sf_result, gsl_sf_result, 0, free, rslt); gsl_sf_choose_e(FIX2INT(n), FIX2INT(m), rslt); return v; }
static VALUE rb_gsl_permutation_set(VALUE obj, VALUE ii, VALUE val) { gsl_permutation *p = NULL; CHECK_FIXNUM(ii); CHECK_FIXNUM(val); Data_Get_Struct(obj, gsl_permutation, p); p->data[FIX2INT(ii)] = FIX2INT(val); return obj; }
static VALUE rb_gsl_combination_set(VALUE obj, VALUE ii, VALUE val) { gsl_combination *c = NULL; size_t i; CHECK_FIXNUM(ii); CHECK_FIXNUM(val); Data_Get_Struct(obj, gsl_combination, c); i = FIX2INT(ii); c->data[i] = FIX2INT(val); return obj; }
static VALUE rb_gsl_sf_lnchoose_e(VALUE obj, VALUE n, VALUE m) { gsl_sf_result *rslt = NULL; VALUE v; // local variable "status" declared and set, but never used //int status; CHECK_FIXNUM(n); CHECK_FIXNUM(m); v = Data_Make_Struct(cgsl_sf_result, gsl_sf_result, 0, free, rslt); /*status =*/ gsl_sf_lnchoose_e(FIX2INT(n), FIX2INT(m), rslt); return v; }
static VALUE rb_gsl_sf_legendre_Plm_e(VALUE obj, VALUE l, VALUE m, VALUE x) { gsl_sf_result *rslt = NULL; VALUE v; int status; CHECK_FIXNUM(l); CHECK_FIXNUM(m); Need_Float(x); v = Data_Make_Struct(cgsl_sf_result, gsl_sf_result, 0, free, rslt); status = gsl_sf_legendre_Plm_e(FIX2INT(l), FIX2INT(m), NUM2DBL(x), rslt); return rb_ary_new3(2, v, INT2FIX(status)); }
LispObj * Lisp_XDrawLine(LispBuiltin *builtin) /* x-draw-line display drawable gc x1 y1 x2 y2 */ { Display *display; Drawable drawable; GC gc; int x1, y1, x2, y2; LispObj *odisplay, *odrawable, *ogc, *ox1, *oy1, *ox2, *oy2; oy2 = ARGUMENT(6); ox2 = ARGUMENT(5); oy1 = ARGUMENT(4); ox1 = ARGUMENT(3); ogc = ARGUMENT(2); odrawable = ARGUMENT(1); odisplay = ARGUMENT(0); if (!CHECKO(odisplay, x11Display_t)) LispDestroy("%s: cannot convert %s to Display*", STRFUN(builtin), STROBJ(odisplay)); display = (Display*)(odisplay->data.opaque.data); /* XXX correct check when drawing to pixmaps implemented */ if (!CHECKO(odrawable, x11Window_t)) LispDestroy("%s: cannot convert %s to Drawable", STRFUN(builtin), STROBJ(odrawable)); drawable = (Drawable)(odrawable->data.opaque.data); if (!CHECKO(ogc, x11GC_t)) LispDestroy("%s: cannot convert %s to Display*", STRFUN(builtin), STROBJ(ogc)); gc = (GC)(ogc->data.opaque.data); CHECK_FIXNUM(ox1); x1 = FIXNUM_VALUE(ox1); CHECK_FIXNUM(oy1); y1 = FIXNUM_VALUE(oy1); CHECK_FIXNUM(ox2); x2 = FIXNUM_VALUE(ox2); CHECK_FIXNUM(oy2); y2 = FIXNUM_VALUE(oy2); XDrawLine(display, drawable, gc, x1, y1, x2, y2); return (odrawable); }
static int get_limit_key_workspace(int argc, VALUE *argv, int argstart, size_t *limit, int *key, gsl_integration_workspace **w) { int flag = 0; switch (argc-argstart) { case 3: CHECK_FIXNUM(argv[argstart]); CHECK_FIXNUM(argv[argstart+1]); CHECK_WORKSPACE(argv[argstart+2]); *limit = FIX2INT(argv[argstart]); *key = FIX2INT(argv[argstart+1]); Data_Get_Struct(argv[argstart+2], gsl_integration_workspace, *w); flag = 0; break; case 1: CHECK_FIXNUM(argv[argstart]); *key = FIX2INT(argv[argstart]); *limit = LIMIT_DEFAULT; *w = gsl_integration_workspace_alloc(*limit); flag = 1; break; case 2: if (TYPE(argv[argc-1]) == T_FIXNUM) { CHECK_FIXNUM(argv[argc-2]); *limit = FIX2INT(argv[argc-2]); *key = FIX2INT(argv[argc-1]); *w = gsl_integration_workspace_alloc(*limit); flag = 1; } else { CHECK_FIXNUM(argv[argc-2]); CHECK_WORKSPACE(argv[argc-1]); *key = FIX2INT(argv[argc-2]); Data_Get_Struct(argv[argc-1], gsl_integration_workspace, *w); *limit = (*w)->limit; flag = 0; } break; case 0: *key = KEY_DEFAULT; *limit = LIMIT_DEFAULT; *w = gsl_integration_workspace_alloc(*limit); flag = 1; break; default: rb_raise(rb_eArgError, "wrong number of arguments"); break; } if (*w == NULL) rb_raise(rb_eRuntimeError, "something wrong with workspace"); return flag; }
static VALUE rb_gsl_sf_hydrogenicR_e(VALUE obj, VALUE n, VALUE l, VALUE Z, VALUE r) { gsl_sf_result *rslt = NULL; VALUE v; // local variable "status" declared and set, but never used //int status; CHECK_FIXNUM(n); CHECK_FIXNUM(l); Need_Float(Z); Need_Float(r); v = Data_Make_Struct(cgsl_sf_result, gsl_sf_result, 0, free, rslt); /*status =*/ gsl_sf_hydrogenicR_e(FIX2INT(n), FIX2INT(l), NUM2DBL(Z), NUM2DBL(r), rslt); return v; }
static VALUE rb_gsl_sf_legendre_sphPlm_array(VALUE obj, VALUE lmax, VALUE m, VALUE x) { gsl_vector *v = NULL; int size; int ll, mm; CHECK_FIXNUM(lmax); CHECK_FIXNUM(m); Need_Float(x); ll = FIX2INT(lmax); mm = FIX2INT(m); size = gsl_sf_legendre_array_size(ll, mm); v = gsl_vector_alloc(size); gsl_sf_legendre_sphPlm_array(ll, mm, NUM2DBL(x), v->data); return Data_Wrap_Struct(cgsl_vector, 0, gsl_vector_free, v); }
/* linear fit with weights: y = c0 + c1 x */ static VALUE rb_gsl_fit_wlinear(int argc, VALUE *argv, VALUE obj) { double *ptrx, *ptry, *ptrw; double c0, c1, cov00, cov01, cov11, sumsq; int status; size_t n, stridex, stridey, stridew; switch (argc) { case 3: ptrx = get_vector_ptr(argv[0], &stridex, &n); ptrw = get_vector_ptr(argv[1], &stridew, &n); ptry = get_vector_ptr(argv[2], &stridey, &n); break; case 4: CHECK_FIXNUM(argv[3]); ptrx = get_vector_ptr(argv[0], &stridex, &n); ptrw = get_vector_ptr(argv[1], &stridew, &n); ptry = get_vector_ptr(argv[2], &stridey, &n); n = FIX2INT(argv[3]); break; default: rb_raise(rb_eArgError, "wrong number of arguments (%d for 2 or 3)", argc); break; } status = gsl_fit_wlinear(ptrx, stridex, ptrw, stridew, ptry, stridey, n, &c0, &c1, &cov00, &cov01, &cov11, &sumsq); return rb_ary_new3(7, rb_float_new(c0), rb_float_new(c1), rb_float_new(cov00), rb_float_new(cov01), rb_float_new(cov11), rb_float_new(sumsq), INT2FIX(status)); }
LispObj * Lisp_XBell(LispBuiltin *builtin) /* x-bell &optional percent */ { Display *display; int percent; LispObj *odisplay, *opercent; opercent = ARGUMENT(1); odisplay = ARGUMENT(0); if (!CHECKO(odisplay, x11Display_t)) LispDestroy("%s: cannot convert %s to Display*", STRFUN(builtin), STROBJ(odisplay)); display = (Display*)(odisplay->data.opaque.data); if (opercent == UNSPEC) percent = 0; else { CHECK_FIXNUM(opercent); percent = FIXNUM_VALUE(opercent); } if (percent < -100 || percent > 100) LispDestroy("%s: percent value %d out of range -100 to 100", STRFUN(builtin), percent); XBell(display, percent); return (odisplay); }
static VALUE rb_gsl_fft_halfcomplex_wavetable_new(VALUE klass, VALUE n) { CHECK_FIXNUM(n); return Data_Wrap_Struct(klass, 0, gsl_fft_halfcomplex_wavetable_free, gsl_fft_halfcomplex_wavetable_alloc(FIX2INT(n))); }
LispObj * Lisp_XDefaultGC(LispBuiltin *builtin) /* x-default-gc display &optional screen */ { Display *display; int screen; LispObj *odisplay, *oscreen; oscreen = ARGUMENT(1); odisplay = ARGUMENT(0); if (!CHECKO(odisplay, x11Display_t)) LispDestroy("%s: cannot convert %s to Display*", STRFUN(builtin), STROBJ(odisplay)); display = (Display*)(odisplay->data.opaque.data); if (oscreen == UNSPEC) screen = DefaultScreen(display); else { CHECK_FIXNUM(oscreen); screen = FIXNUM_VALUE(oscreen); } if (screen >= ScreenCount(display)) LispDestroy("%s: screen index %d too large, %d screens available", STRFUN(builtin), screen, ScreenCount(display)); return (OPAQUE(DefaultGC(display, screen), x11GC_t)); }
static VALUE rb_gsl_sf_coulomb_wave_FGp_array(VALUE obj, VALUE Lmin, VALUE kmax, VALUE eta, VALUE x) { double F_exponent, G_exponent; int status; size_t size; gsl_vector *vf = NULL, *vg = NULL, *vfp = NULL, *vgp = NULL; VALUE fary, gary, fpary, gpary; CHECK_FIXNUM(kmax); Need_Float(Lmin); Need_Float(eta); Need_Float(x); size = FIX2INT(kmax); vf = gsl_vector_alloc(size); vfp = gsl_vector_alloc(size); vg = gsl_vector_alloc(size); vgp = gsl_vector_alloc(size); status = gsl_sf_coulomb_wave_FGp_array(NUM2DBL(Lmin), size, NUM2DBL(eta), NUM2DBL(x), vf->data, vfp->data, vg->data, vgp->data, &F_exponent, &G_exponent); fary = Data_Wrap_Struct(cgsl_vector, 0, gsl_vector_free, vf); fpary =Data_Wrap_Struct(cgsl_vector, 0, gsl_vector_free, vfp); gary = Data_Wrap_Struct(cgsl_vector, 0, gsl_vector_free, vg); gpary =Data_Wrap_Struct(cgsl_vector, 0, gsl_vector_free, vgp); return rb_ary_new3(7, fary, fpary, gary, gpary, rb_float_new(F_exponent), rb_float_new(G_exponent), INT2FIX(status)); }
static VALUE rb_gsl_permutation_calloc(VALUE klass, VALUE nn) { gsl_permutation *p = NULL; CHECK_FIXNUM(nn); p = gsl_permutation_calloc(FIX2INT(nn)); return Data_Wrap_Struct(klass, 0, gsl_permutation_free, p); }
LispObj * Lisp_DigitChar(LispBuiltin *builtin) /* digit-char weight &optional radix */ { long radix = 10, weight; LispObj *oweight, *oradix, *result = NIL; oradix = ARGUMENT(1); oweight = ARGUMENT(0); CHECK_FIXNUM(oweight); weight = FIXNUM_VALUE(oweight); if (oradix != UNSPEC) { CHECK_INDEX(oradix); radix = FIXNUM_VALUE(oradix); } if (radix < 2 || radix > 36) LispDestroy("%s: radix must be >= 2 and <= 36, not %ld", STRFUN(builtin), radix); if (weight >= 0 && weight < radix) { if (weight < 9) weight += '0'; else weight += 'A' - 10; result = SCHAR(weight); } return (result); }
static VALUE rb_gsl_sum_levin_utrunc_new(VALUE klass, VALUE nn) { gsl_sum_levin_utrunc_workspace *w = NULL; CHECK_FIXNUM(nn); w = gsl_sum_levin_utrunc_alloc(FIX2INT(nn)); return Data_Wrap_Struct(klass, 0, gsl_sum_levin_utrunc_free, w); }
static VALUE rb_gsl_cheb_new(VALUE klass, VALUE nn) { gsl_cheb_series *p = NULL; CHECK_FIXNUM(nn); p = gsl_cheb_alloc(FIX2INT(nn)); return Data_Wrap_Struct(klass, 0, gsl_cheb_free, p); }
static VALUE rb_gsl_wavelet_workspace_new(VALUE klass, VALUE nn) { gsl_wavelet_workspace *wspace = NULL; CHECK_FIXNUM(nn); wspace = gsl_wavelet_workspace_alloc(FIX2INT(nn)); if (wspace == NULL) rb_raise(rb_eNoMemError, "gsl_wavelet_workspace_alloc failed"); return Data_Wrap_Struct(klass, 0, gsl_wavelet_workspace_free, wspace); }
static VALUE rb_gsl_sf_coupling_9j(VALUE obj, VALUE two_ja, VALUE two_jb, VALUE two_jc, VALUE two_jd, VALUE two_je, VALUE two_jf, VALUE two_jg, VALUE two_jh, VALUE two_ji) { CHECK_FIXNUM(two_ja); CHECK_FIXNUM(two_jb); CHECK_FIXNUM(two_jc); CHECK_FIXNUM(two_jd); CHECK_FIXNUM(two_je); CHECK_FIXNUM(two_jf); CHECK_FIXNUM(two_jg); CHECK_FIXNUM(two_jh); CHECK_FIXNUM(two_ji); return rb_float_new(gsl_sf_coupling_9j(FIX2INT(two_ja), FIX2INT(two_jb), FIX2INT(two_jc), FIX2INT(two_jd), FIX2INT(two_je), FIX2INT(two_jf), FIX2INT(two_jg), FIX2INT(two_jh), FIX2INT(two_ji))); }
static VALUE rb_gsl_sf_gegenpoly_array(VALUE obj, VALUE nmax, VALUE lambda, VALUE x) { gsl_vector *v = NULL; CHECK_FIXNUM(nmax); Need_Float(lambda); Need_Float(x); v = gsl_vector_alloc(nmax); gsl_sf_gegenpoly_array(FIX2INT(nmax), NUM2DBL(lambda), NUM2DBL(x), v->data); return Data_Wrap_Struct(cgsl_vector, 0, gsl_vector_free, v); }
static VALUE rb_gsl_fminimizer_new(VALUE klass, VALUE t, VALUE n) { gsl_multimin_fminimizer *gmf = NULL; const gsl_multimin_fminimizer_type *T; CHECK_FIXNUM(n); T = get_fminimizer_type(t); gmf = gsl_multimin_fminimizer_alloc(T, FIX2INT(n)); return Data_Wrap_Struct(klass, 0, gsl_multimin_fminimizer_free, gmf); }
static VALUE rb_gsl_sf_legendre_Pl_array(VALUE obj, VALUE lmax, VALUE x) { gsl_vector *v = NULL; CHECK_FIXNUM(lmax); Need_Float(x); v = gsl_vector_alloc(FIX2INT(lmax) + 1); gsl_sf_legendre_Pl_array(FIX2INT(lmax), NUM2DBL(x), v->data); return Data_Wrap_Struct(cgsl_vector, 0, gsl_vector_free, v); }
static VALUE rb_gsl_poly_define_poly(VALUE klass, VALUE order, gsl_poly_int* (*f)(int n1)) { int n1; gsl_poly_int *pnew = NULL; CHECK_FIXNUM(order); n1 = FIX2INT(order); if (n1 < 0) rb_raise(rb_eArgError, "order must be >= 0"); pnew = (*f)(n1); return Data_Wrap_Struct(cgsl_poly_int, 0, gsl_vector_int_free, pnew); }
static VALUE rb_gsl_odeiv_step_new(int argc, VALUE *argv, VALUE klass) { VALUE obj; gsl_odeiv_step *s = NULL; switch (argc) { case 1: CHECK_FIXNUM(argv[0]); s = make_step(INT2FIX(GSL_ODEIV_STEP_RKF45), argv[0]); break; case 2: CHECK_FIXNUM(argv[1]); s = make_step(argv[0], argv[1]); break; default: rb_raise(rb_eArgError, "wrong number of arguments (%d for 1 or 2)", argc); } obj = Data_Wrap_Struct(klass, 0, gsl_odeiv_step_free, s); return obj; }
static VALUE rb_gsl_blas_dsyrk(VALUE obj, VALUE u, VALUE t, VALUE a, VALUE aa, VALUE b, VALUE cc) { gsl_matrix *A = NULL, *C = NULL; double alpha, beta; CBLAS_UPLO_t Uplo; CBLAS_TRANSPOSE_t Trans; CHECK_FIXNUM(u); CHECK_FIXNUM(t); Need_Float(a); Need_Float(b); CHECK_MATRIX(aa); CHECK_MATRIX(cc); Uplo = FIX2INT(u); Trans = FIX2INT(t); alpha = NUM2DBL(a); beta = NUM2DBL(b); Data_Get_Struct(aa, gsl_matrix, A); Data_Get_Struct(cc, gsl_matrix, C); gsl_blas_dsyrk(Uplo, Trans, alpha, A, beta, C); return cc; }
static VALUE rb_gsl_blas_zsyrk(VALUE obj, VALUE u, VALUE t, VALUE a, VALUE aa, VALUE b, VALUE cc) { gsl_matrix_complex *A = NULL, *C = NULL; gsl_complex *pa = NULL, *pb = NULL; CBLAS_UPLO_t Uplo; CBLAS_TRANSPOSE_t Trans; CHECK_FIXNUM(u); CHECK_FIXNUM(t); CHECK_COMPLEX(a); CHECK_COMPLEX(b); CHECK_MATRIX_COMPLEX(aa); CHECK_MATRIX_COMPLEX(cc); Uplo = FIX2INT(u); Trans = FIX2INT(t); Data_Get_Struct(a, gsl_complex, pa); Data_Get_Struct(b, gsl_complex, pb); Data_Get_Struct(aa, gsl_matrix_complex, A); Data_Get_Struct(cc, gsl_matrix_complex, C); gsl_blas_zsyrk(Uplo, Trans, *pa, A, *pb, C); return cc; }