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