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_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));
}
/* 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_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_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_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_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_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_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_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_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);
}
/* 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_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_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_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;
}
CAMLprim value
ml_cairo_set_dash (value cr, value d, value off)
{
#ifndef ARCH_ALIGN_DOUBLE
cairo_set_dash (cairo_t_val (cr), Double_array_val (d),
Double_array_length (d), Double_val (off));
#else
int i, ndash = Double_array_length (d);
double *dashes = caml_stat_alloc (ndash * sizeof (double));
for (i = 0; i < ndash; i++)
dashes[i] = Double_field (d, i);
cairo_set_dash (cairo_t_val (cr), dashes, ndash, Double_val (off));
caml_stat_free (dashes);
#endif
check_cairo_status (cr);
return Val_unit;
}
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);
}
/* 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;
}
static void
check_array (value vf)
{
mlsize_t len = Double_array_length (Field (vf, 0));
size_t off = Long_val (Field (vf, 1));
size_t n = Long_val (Field (vf, 2));
size_t stride = Long_val (Field (vf, 3));
if (off + (n - 1) * stride >= len)
GSL_ERROR_VOID ("Inconsistent array specification", GSL_EBADLEN);
}
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);
}
CAMLprim value ml_gsl_stats_minmax_index(value data)
{
size_t len = Double_array_length(data);
size_t mi, ma;
value r;
gsl_stats_minmax_index(&mi, &ma, Double_array_val(data), 1, len);
r = alloc_small(2, 0);
Field(r, 0) = Val_int(mi);
Field(r, 1) = Val_int(ma);
return r;
}
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_odeiv_control_scaled_new(value eps_abs, value eps_rel,
value a_y, value a_dydt, value scale_abs)
{
gsl_odeiv_control *c =
gsl_odeiv_control_scaled_new(Double_val(eps_abs), Double_val(eps_rel),
Double_val(a_y), Double_val(a_dydt),
Double_array_val(scale_abs),
Double_array_length(scale_abs));
value res;
Abstract_ptr(res, c);
return res;
}
CAMLprim value
ml_gsl_sf_legendre_array(value norm, value vlmax, value m, value x,
value result_array)
{
const size_t lmax = Int_val(vlmax);
if (Double_array_length(result_array) < gsl_sf_legendre_array_n(lmax)) {
caml_invalid_argument("Gsl_sf.legendre_array: array too small");
}
gsl_sf_legendre_array(Int_val(norm),
lmax,
Double_val(x),
Double_array_val(result_array));
return Val_unit;
}
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);
}
/* MULTINOMIAL */
CAMLprim value ml_gsl_ran_multinomial(value rng, value n, value p)
{
const size_t K = Double_array_length(p);
LOCALARRAY(unsigned int, N, K);
value r;
gsl_ran_multinomial(Rng_val(rng), K, Int_val(n), Double_array_val(p), N);
{
register int i;
r = alloc(K, 0);
for(i=0; i<K; i++)
Store_field(r, i, Val_int(N[i]));
}
return r;
}
CAMLprim value ml_gsl_odeiv_step_apply(value step, value t, value h, value y,
value yerr, value odydt_in, value odydt_out,
value syst)
{
CAMLparam5(step, syst, y, yerr, odydt_out);
LOCALARRAY(double, y_copy, Double_array_length(y));
LOCALARRAY(double, yerr_copy, Double_array_length(yerr));
size_t len_dydt_in =
odydt_in == Val_none ? 0 : Double_array_length(Unoption(odydt_in)) ;
size_t len_dydt_out =
odydt_out == Val_none ? 0 : Double_array_length(Unoption(odydt_out)) ;
LOCALARRAY(double, dydt_in, len_dydt_in);
LOCALARRAY(double, dydt_out, len_dydt_out);
int status;
if(len_dydt_in)
memcpy(dydt_in, Double_array_val(Unoption(odydt_in)), Bosize_val(Unoption(odydt_in)));
memcpy(y_copy, Double_array_val(y), Bosize_val(y));
memcpy(yerr_copy, Double_array_val(yerr), Bosize_val(yerr));
status = gsl_odeiv_step_apply(ODEIV_STEP_VAL(step),
Double_val(t), Double_val(h),
y_copy, yerr_copy,
len_dydt_in ? dydt_in : NULL,
len_dydt_out ? dydt_out : NULL,
ODEIV_SYSTEM_VAL(syst));
/* GSL does not call the error handler for this function */
if (status)
GSL_ERROR_VAL ("gsl_odeiv_step_apply", status, Val_unit);
memcpy(Double_array_val(y), y_copy, sizeof(y_copy));
memcpy(Double_array_val(yerr), yerr_copy, sizeof(yerr_copy));
if(len_dydt_out)
memcpy(Double_array_val(Unoption(odydt_out)), dydt_out, Bosize_val(Unoption(odydt_out)));
CAMLreturn(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);
}
