virtual int exec(double* integral,double* error){
assert(ncomp==1); // gsl mc integration does only single component yo!
gsl_monte_integrand_wrapper iw;
iw.ncomp = ncomp;
iw.params = params;
iw.integrand = integrand;
gsl_monte_function G;
G.f = gsl_monte_integrand_wrapper::f;
G.dim = ndim;
G.params = (void*) &iw;
double xl[ndim];
double xu[ndim];
std::fill(xl,xl+ndim,0.); // unit cube!
std::fill(xu,xu+ndim,1.); // unit cube!
const gsl_rng_type* T;
gsl_rng* r;
gsl_rng_env_setup();
T = gsl_rng_default;
r = gsl_rng_alloc(T);
gsl_monte_miser_state* s = gsl_monte_miser_alloc(ndim);
gsl_monte_miser_integrate(&G,xl,xu,ndim,calls,r,s,integral,error);
gsl_monte_miser_free(s);
gsl_rng_free(r);
return 0; // succes!
}
CAMLprim value ml_gsl_monte_miser_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_miser_integrate(¶ms->gslfun.mf,
c_xlo, c_xup, dim,
Int_val(calls),
Rng_val(rng),
GSLMISERSTATE_VAL(state),
&result, &abserr);
CAMLreturn(copy_two_double_arr(result, abserr));
}
void monte_carlo_integration()
{
double res, err;
double xl[3] = { 0, 0, 0 };
double xu[3] = { M_PI, M_PI, M_PI };
gsl_monte_function G = { &local::g, 3, NULL };
const std::size_t calls = 500000;
gsl_rng_env_setup();
const gsl_rng_type *T = gsl_rng_default;
gsl_rng *r = gsl_rng_alloc(T);
//
{
gsl_monte_plain_state *s = gsl_monte_plain_alloc(3);
gsl_monte_plain_integrate(&G, xl, xu, 3, calls, r, s, &res, &err);
gsl_monte_plain_free(s);
local::display_results("plain", res, err);
}
//
{
gsl_monte_miser_state *s = gsl_monte_miser_alloc(3);
gsl_monte_miser_integrate(&G, xl, xu, 3, calls, r, s, &res, &err);
gsl_monte_miser_free(s);
local::display_results("miser", res, err);
}
//
{
gsl_monte_vegas_state *s = gsl_monte_vegas_alloc(3);
gsl_monte_vegas_integrate(&G, xl, xu, 3, 10000, r, s, &res, &err);
local::display_results("vegas warm-up", res, err);
std::cout << "converging..." << std::endl;
do
{
gsl_monte_vegas_integrate(&G, xl, xu, 3, calls/5, r, s, &res, &err);
std::cout << "result = " << res << " sigma = " << err << " chisq/dof = " << s->chisq << std::endl;
} while (std::fabs(s->chisq - 1.0) > 0.5);
local::display_results("vegas final", res, err);
gsl_monte_vegas_free(s);
}
}
int
gsl_monte_miser_integrate (gsl_monte_function * f,
const double xl[], const double xu[],
size_t dim, size_t calls,
gsl_rng * r,
gsl_monte_miser_state * state,
double *result, double *abserr)
{
size_t n, estimate_calls, calls_l, calls_r;
const size_t min_calls = state->min_calls;
size_t i;
size_t i_bisect;
int found_best;
double res_est = 0, err_est = 0;
double res_r = 0, err_r = 0, res_l = 0, err_l = 0;
double xbi_l, xbi_m, xbi_r, s;
double vol;
double weight_l, weight_r;
double *x = state->x;
double *xmid = state->xmid;
double *sigma_l = state->sigma_l, *sigma_r = state->sigma_r;
if (dim != state->dim)
{
GSL_ERROR ("number of dimensions must match allocated size", GSL_EINVAL);
}
for (i = 0; i < dim; i++)
{
if (xu[i] <= xl[i])
{
GSL_ERROR ("xu must be greater than xl", GSL_EINVAL);
}
if (xu[i] - xl[i] > GSL_DBL_MAX)
{
GSL_ERROR ("Range of integration is too large, please rescale",
GSL_EINVAL);
}
}
if (state->alpha < 0)
{
GSL_ERROR ("alpha must be non-negative", GSL_EINVAL);
}
/* Compute volume */
vol = 1;
for (i = 0; i < dim; i++)
{
vol *= xu[i] - xl[i];
}
if (calls < state->min_calls_per_bisection)
{
double m = 0.0, q = 0.0;
if (calls < 2)
{
GSL_ERROR ("insufficient calls for subvolume", GSL_EFAILED);
}
for (n = 0; n < calls; n++)
{
/* Choose a random point in the integration region */
for (i = 0; i < dim; i++)
{
x[i] = xl[i] + gsl_rng_uniform_pos (r) * (xu[i] - xl[i]);
}
{
double fval = GSL_MONTE_FN_EVAL (f, x);
/* recurrence for mean and variance */
double d = fval - m;
m += d / (n + 1.0);
q += d * d * (n / (n + 1.0));
}
}
*result = vol * m;
*abserr = vol * sqrt (q / (calls * (calls - 1.0)));
return GSL_SUCCESS;
}
estimate_calls = GSL_MAX (min_calls, calls * (state->estimate_frac));
if (estimate_calls < 4 * dim)
{
GSL_ERROR ("insufficient calls to sample all halfspaces", GSL_ESANITY);
}
/* Flip coins to bisect the integration region with some fuzz */
for (i = 0; i < dim; i++)
{
s = (gsl_rng_uniform (r) - 0.5) >= 0.0 ? state->dither : -state->dither;
state->xmid[i] = (0.5 + s) * xl[i] + (0.5 - s) * xu[i];
}
/* The idea is to chose the direction to bisect based on which will
give the smallest total variance. We could (and may do so later)
use MC to compute these variances. But the NR guys simply estimate
the variances by finding the min and max function values
for each half-region for each bisection. */
estimate_corrmc (f, xl, xu, dim, estimate_calls,
r, state, &res_est, &err_est, xmid, sigma_l, sigma_r);
/* We have now used up some calls for the estimation */
calls -= estimate_calls;
/* Now find direction with the smallest total "variance" */
{
double best_var = GSL_DBL_MAX;
double beta = 2.0 / (1.0 + state->alpha);
found_best = 0;
i_bisect = 0;
weight_l = weight_r = 1.0;
for (i = 0; i < dim; i++)
{
if (sigma_l[i] >= 0 && sigma_r[i] >= 0)
{
/* estimates are okay */
double var = pow (sigma_l[i], beta) + pow (sigma_r[i], beta);
if (var <= best_var)
{
found_best = 1;
best_var = var;
i_bisect = i;
weight_l = pow (sigma_l[i], beta);
weight_r = pow (sigma_r[i], beta);
}
}
else
{
if (sigma_l[i] < 0)
{
GSL_ERROR ("no points in left-half space!", GSL_ESANITY);
}
if (sigma_r[i] < 0)
{
GSL_ERROR ("no points in right-half space!", GSL_ESANITY);
}
}
}
}
if (!found_best)
{
/* All estimates were the same, so chose a direction at random */
i_bisect = gsl_rng_uniform_int (r, dim);
}
xbi_l = xl[i_bisect];
xbi_m = xmid[i_bisect];
xbi_r = xu[i_bisect];
/* Get the actual fractional sizes of the two "halves", and
distribute the remaining calls among them */
{
double fraction_l = fabs ((xbi_m - xbi_l) / (xbi_r - xbi_l));
double fraction_r = 1 - fraction_l;
double a = fraction_l * weight_l;
double b = fraction_r * weight_r;
calls_l = min_calls + (calls - 2 * min_calls) * a / (a + b);
calls_r = min_calls + (calls - 2 * min_calls) * b / (a + b);
}
/* Compute the integral for the left hand side of the bisection */
/* Due to the recursive nature of the algorithm we must allocate
some new memory for each recursive call */
{
int status;
double *xu_tmp = (double *) malloc (dim * sizeof (double));
if (xu_tmp == 0)
{
GSL_ERROR_VAL ("out of memory for left workspace", GSL_ENOMEM, 0);
}
for (i = 0; i < dim; i++)
{
xu_tmp[i] = xu[i];
}
xu_tmp[i_bisect] = xbi_m;
status = gsl_monte_miser_integrate (f, xl, xu_tmp,
dim, calls_l, r, state,
&res_l, &err_l);
free (xu_tmp);
if (status != GSL_SUCCESS)
{
return status;
}
}
/* Compute the integral for the right hand side of the bisection */
{
int status;
double *xl_tmp = (double *) malloc (dim * sizeof (double));
if (xl_tmp == 0)
{
GSL_ERROR_VAL ("out of memory for right workspace", GSL_ENOMEM, 0);
}
for (i = 0; i < dim; i++)
{
xl_tmp[i] = xl[i];
}
xl_tmp[i_bisect] = xbi_m;
status = gsl_monte_miser_integrate (f, xl_tmp, xu,
dim, calls_r, r, state,
&res_r, &err_r);
free (xl_tmp);
if (status != GSL_SUCCESS)
{
return status;
}
}
*result = res_l + res_r;
*abserr = sqrt (err_l * err_l + err_r * err_r);
return GSL_SUCCESS;
}
int
main (void)
{
double res, err;
double xl[3] = { 0, 0, 0 };
double xu[3] = { M_PI, M_PI, M_PI };
const gsl_rng_type *T;
gsl_rng *r;
gsl_monte_function G = { &g, 3, 0 };
size_t calls = 500000;
gsl_rng_env_setup ();
T = gsl_rng_default;
r = gsl_rng_alloc (T);
{
gsl_monte_plain_state *s = gsl_monte_plain_alloc (3);
gsl_monte_plain_integrate (&G, xl, xu, 3, calls, r, s,
&res, &err);
gsl_monte_plain_free (s);
display_results ("plain", res, err);
}
{
gsl_monte_miser_state *s = gsl_monte_miser_alloc (3);
gsl_monte_miser_integrate (&G, xl, xu, 3, calls, r, s,
&res, &err);
gsl_monte_miser_free (s);
display_results ("miser", res, err);
}
{
gsl_monte_vegas_state *s = gsl_monte_vegas_alloc (3);
gsl_monte_vegas_integrate (&G, xl, xu, 3, 10000, r, s,
&res, &err);
display_results ("vegas warm-up", res, err);
printf ("converging...\n");
do
{
gsl_monte_vegas_integrate (&G, xl, xu, 3, calls/5, r, s,
&res, &err);
printf ("result = % .6f sigma = % .6f "
"chisq/dof = %.1f\n", res, err, gsl_monte_vegas_chisq (s));
}
while (fabs (gsl_monte_vegas_chisq (s) - 1.0) > 0.5);
display_results ("vegas final", res, err);
gsl_monte_vegas_free (s);
}
gsl_rng_free (r);
return 0;
}
