CAMLprim value ml_gsl_monte_plain_integrate(value fun, value xlo, value xup,
value calls, value rng, value state)
{
CAMLparam2(rng, state);
double result, abserr;
size_t dim=Double_array_length(xlo);
LOCALARRAY(double, c_xlo, dim);
LOCALARRAY(double, c_xup, dim);
struct callback_params *params=CallbackParams_val(state);
if(params->gslfun.mf.dim != dim)
GSL_ERROR("wrong number of dimensions for function", GSL_EBADLEN);
if(Double_array_length(xup) != dim)
GSL_ERROR("array sizes differ", GSL_EBADLEN);
params->closure = fun;
memcpy(c_xlo, Double_array_val(xlo), dim*sizeof(double));
memcpy(c_xup, Double_array_val(xup), dim*sizeof(double));
gsl_monte_plain_integrate(¶ms->gslfun.mf,
c_xlo, c_xup, dim,
Int_val(calls),
Rng_val(rng),
GSLPLAINSTATE_VAL(state),
&result, &abserr);
CAMLreturn(copy_two_double_arr(result, abserr));
}
CAMLprim value ml_gsl_fit_mul(value wo, value x, value y)
{
value r;
size_t N=Double_array_length(x);
double c1,cov11,sumsq;
if(Double_array_length(y) != N)
GSL_ERROR("array sizes differ", GSL_EBADLEN);
if(wo == Val_none)
gsl_fit_mul(Double_array_val(x), 1, Double_array_val(y), 1, N,
&c1, &cov11, &sumsq);
else {
value w=Field(wo, 0);
if(Double_array_length(w) != N)
GSL_ERROR("array sizes differ", GSL_EBADLEN);
gsl_fit_wmul(Double_array_val(x), 1,
Double_array_val(w), 1,
Double_array_val(y), 1, N,
&c1, &cov11, &sumsq);
}
r=alloc_small(3 * Double_wosize, Double_array_tag);
Store_double_field(r, 0, c1);
Store_double_field(r, 1, cov11);
Store_double_field(r, 2, sumsq);
return r;
}
CAMLprim value ml_gsl_stats_covariance(value data1, value data2)
{
size_t len = Double_array_length(data1);
double result;
check_array_size(data1, data2);
result = gsl_stats_covariance(Double_array_val(data1), 1,
Double_array_val(data2), 1, len);
return copy_double(result);
}
/* DIRICHLET */
CAMLprim value ml_gsl_ran_dirichlet(value rng, value alpha, value theta)
{
const size_t K = Double_array_length(alpha);
if(Double_array_length(theta) != K)
GSL_ERROR("alpha and theta must have same size", GSL_EBADLEN);
gsl_ran_dirichlet(Rng_val(rng), K, Double_array_val(alpha),
Double_array_val(theta));
return Val_unit;
}
CAMLprim value ml_gsl_ran_dirichlet_lnpdf(value alpha, value theta)
{
const size_t K = Double_array_length(alpha);
double r ;
if(Double_array_length(theta) != K)
GSL_ERROR("alpha and theta must have same size", GSL_EBADLEN);
r = gsl_ran_dirichlet_lnpdf(K, Double_array_val(alpha),
Double_array_val(theta));
return copy_double(r);
}
CAMLprim value ml_gsl_stats_lag1_autocorrelation(value omean, value data)
{
size_t len = Double_array_length(data);
double result;
if(omean == Val_none)
result = gsl_stats_lag1_autocorrelation(Double_array_val(data), 1, len);
else
result = gsl_stats_lag1_autocorrelation_m(Double_array_val(data), 1, len,
Double_val(Unoption(omean)));
return copy_double(result);
}
static int ml_gsl_odeiv_func(double t, const double y[],
double dydt[], void *params)
{
struct mlgsl_odeiv_params *p = params;
value vt, res;
vt = copy_double(t);
memcpy(Double_array_val(p->arr1), y, p->dim * sizeof(double));
res = callback3_exn(p->closure, vt, p->arr1, p->arr2);
if(Is_exception_result(res))
return GSL_FAILURE;
memcpy(dydt, Double_array_val(p->arr2), p->dim * sizeof(double));
return GSL_SUCCESS;
}
CAMLprim value ml_gsl_stats_mean(value ow, value data)
{
size_t len = Double_array_length(data);
double result;
if(ow == Val_none)
result = gsl_stats_mean(Double_array_val(data), 1, len);
else {
value w = Unoption(ow);
check_array_size(data, w);
result = gsl_stats_wmean(Double_array_val(w), 1,
Double_array_val(data), 1, len);
}
return copy_double(result);
}
CAMLprim value ml_gsl_ran_sample(value rng, value src, value dest)
{
if(Tag_val(src) == Double_array_tag)
gsl_ran_sample(Rng_val(rng),
Double_array_val(dest), Double_array_length(dest),
Double_array_val(src), Double_array_length(src),
sizeof(double));
else
gsl_ran_sample(Rng_val(rng),
(value *)dest, Array_length(dest),
(value *)src, Array_length(src),
sizeof(value));
return Val_unit;
}
CAMLprim value ml_gsl_stats_minmax(value data)
{
size_t len = Double_array_length(data);
double mi, ma;
gsl_stats_minmax(&mi, &ma, Double_array_val(data), 1, len);
return copy_two_double(mi, ma);
}
CAMLprim value ml_gsl_qrng_sample(value qrng)
{
gsl_qrng * q = Qrng_val(qrng);
value arr = alloc(q->dimension * Double_wosize, Double_array_tag);
gsl_qrng_get(q, Double_array_val(arr));
return arr;
}
CAMLprim value ml_gsl_qrng_get(value qrng, value x)
{
if(Double_array_length(x) != (Qrng_val(qrng))->dimension)
GSL_ERROR("wrong array size", GSL_EBADLEN);
gsl_qrng_get(Qrng_val(qrng), Double_array_val(x));
return Val_unit;
}
CAMLprim value ml_gsl_stats_quantile_from_sorted_data(value data, value f)
{
size_t len = Double_array_length(data);
double r = gsl_stats_quantile_from_sorted_data(Double_array_val(data),
1, len, Double_val(f));
return copy_double(r);
}
CAMLprim value ml_gsl_sf_legendre_Pl_array(value x, value r_arr)
{
gsl_sf_legendre_Pl_array(Double_array_length(r_arr)-1,
Double_val(x),
Double_array_val(r_arr));
return Val_unit;
}
CAMLprim value ml_gsl_sum_levin_utrunc_accel(value arr, value ws)
{
double sum_accel, abserr;
gsl_sum_levin_utrunc_accel(Double_array_val(arr), Double_array_length(arr),
WStrunc_val(ws), &sum_accel, &abserr);
return copy_two_double_arr(sum_accel, abserr);
}
CAMLprim value ml_gsl_sf_bessel_jl_steed_array(value x, value x_arr)
{
gsl_sf_bessel_jl_steed_array(Double_array_length(x_arr)-1,
Double_val(x),
Double_array_val(x_arr));
return Val_unit;
}
CAMLprim value ml_gsl_sf_bessel_sequence_Jnu_e(value nu, value mode, value x)
{
gsl_sf_bessel_sequence_Jnu_e(Double_val(nu), GSL_MODE_val(mode),
Double_array_length(x),
Double_array_val(x));
return Val_unit;
}
CAMLprim value ml_gsl_sf_gegenpoly_array(value lambda, value x, value r_arr)
{
gsl_sf_gegenpoly_array(Double_array_length(r_arr)-1,
Double_val(lambda),
Double_val(x),
Double_array_val(r_arr));
return Val_unit;
}
CAMLprim value ml_gsl_sf_coulomb_CL_array(value lmin, value eta, value c_arr)
{
gsl_sf_coulomb_CL_array(Double_val(lmin),
Double_array_length(c_arr)-1,
Double_val(eta),
Double_array_val(c_arr));
return Val_unit;
}
/* DISCRETE */
CAMLprim value ml_gsl_ran_discrete_preproc(value p)
{
gsl_ran_discrete_t *G;
value r;
G = gsl_ran_discrete_preproc(Double_array_length(p), Double_array_val(p));
Abstract_ptr(r, G);
return r;
}
CAMLprim value
ml_gsl_sort_vector_largest (value dest, value v)
{
_DECLARE_VECTOR(v);
_CONVERT_VECTOR(v);
gsl_sort_vector_largest (Double_array_val (dest), Double_array_length (dest), &v_v);
return Val_unit;
}
CAMLprim value ml_gsl_histogram_set_ranges(value vh, value range)
{
gsl_histogram h;
histo_of_val(&h, vh);
gsl_histogram_set_ranges(&h, Double_array_val(range),
Double_array_length(range));
return Val_unit;
}
CAMLprim value ml_gsl_stats_kurtosis_m_sd(value ow, value mean,
value sd, value data)
{
size_t len = Double_array_length(data);
double result;
if(ow == Val_none)
result = gsl_stats_kurtosis_m_sd(Double_array_val(data), 1, len,
Double_val(mean), Double_val(sd));
else {
value w = Unoption(ow);
check_array_size(data, w);
result = gsl_stats_wkurtosis_m_sd(Double_array_val(w), 1,
Double_array_val(data), 1, len,
Double_val(mean), Double_val(sd));
}
return copy_double(result);
}
static int ml_gsl_odeiv_jacobian(double t, const double y[],
double *dfdy, double dfdt[],
void *params)
{
struct mlgsl_odeiv_params *p = params;
value res, args[4];
args[0] = copy_double(t);
memcpy(Double_array_val(p->arr1), y, p->dim * sizeof(double));
args[1] = p->arr1;
Data_bigarray_val(p->mat) = dfdy;
args[2] = p->mat;
args[3] = p->arr2;
res = callbackN_exn(p->jac_closure, 4, args);
if(Is_exception_result(res))
return GSL_FAILURE;
memcpy(dfdt, Double_array_val(p->arr2), p->dim * sizeof(double));
return GSL_SUCCESS;
}
CAMLprim value
ml_gsl_sf_legendre_Plm_array(value lmax, value m, value x, value result_array)
{
gsl_sf_legendre_Plm_array(Int_val(lmax),
Int_val(m),
Double_val(x),
Double_array_val(result_array));
return Val_unit;
}
/* MONTE CALLBACKS */
double gsl_monte_callback(double *x_arr, size_t dim, void *params)
{
struct callback_params *p=params;
value res;
memcpy(Double_array_val(p->dbl), x_arr, dim*sizeof(double));
res=callback(p->closure, p->dbl);
return Double_val(res);
}
CAMLprim value ml_gsl_odeiv_control_hadjust(value c, value s, value y,
value yerr, value dydt, value h)
{
double c_h = Double_val(h);
int status =
gsl_odeiv_control_hadjust(ODEIV_CONTROL_VAL(c), ODEIV_STEP_VAL(s),
Double_array_val(y), Double_array_val(yerr),
Double_array_val(dydt), &c_h);
{
CAMLparam0();
CAMLlocal2(vh, r);
vh = copy_double(c_h);
r = alloc_small(2, 0);
Field(r, 0) = Val_int(status + 1);
Field(r, 1) = vh;
CAMLreturn(r);
}
}
/* SHUFFLING */
CAMLprim value ml_gsl_ran_shuffle(value rng, value arr)
{
if(Tag_val(arr) == Double_array_tag)
gsl_ran_shuffle(Rng_val(rng), Double_array_val(arr),
Double_array_length(arr), sizeof(double));
else
gsl_ran_shuffle(Rng_val(rng), (value *)arr,
Array_length(arr), sizeof(value));
return Val_unit;
}
CAMLprim value ml_gsl_ran_multinomial_lnpdf(value p, value n)
{
const size_t K = Double_array_length(p);
LOCALARRAY(unsigned int, N, K);
double r;
register int i;
for(i=0; i<K; i++)
N[i] = Int_val(Field(n, i));
r = gsl_ran_multinomial_lnpdf(K, Double_array_val(p), N);
return copy_double(r);
}
CAMLprim value
ml_gsl_wavelet_transform (value w, value dir, value vf, value ws)
{
double *data = Double_array_val (Field (vf, 0)) + Long_val (Field (vf, 1));
size_t n = Long_val (Field (vf, 2));
size_t stride = Long_val (Field (vf, 3));
check_array (vf);
gsl_wavelet_transform (Wavelet_val (w), data, stride, n,
gsl_direction_val (dir), WS_val (ws));
return Val_unit;
}
