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
gsl_monte_plain_integrate (const gsl_monte_function * f,
const double xl[], const double xu[],
const size_t dim,
const size_t calls,
gsl_rng * r,
gsl_monte_plain_state * state,
double *result, double *abserr)
{
double vol, m = 0, q = 0;
double *x = state->x;
size_t n, i;
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);
}
}
/* Compute the volume of the region */
vol = 1;
for (i = 0; i < dim; i++)
{
vol *= xu[i] - xl[i];
}
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;
if (calls < 2)
{
*abserr = GSL_POSINF;
}
else
{
*abserr = vol * sqrt (q / (calls * (calls - 1.0)));
}
return GSL_SUCCESS;
}
static int
estimate_corrmc (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,
const double xmid[], double sigma_l[], double sigma_r[])
{
size_t i, n;
double *x = state->x;
double *fsum_l = state->fsum_l;
double *fsum_r = state->fsum_r;
double *fsum2_l = state->fsum2_l;
double *fsum2_r = state->fsum2_r;
size_t *hits_l = state->hits_l;
size_t *hits_r = state->hits_r;
double m = 0.0, q = 0.0;
double vol = 1.0;
for (i = 0; i < dim; i++)
{
vol *= xu[i] - xl[i];
hits_l[i] = hits_r[i] = 0;
fsum_l[i] = fsum_r[i] = 0.0;
fsum2_l[i] = fsum2_r[i] = 0.0;
sigma_l[i] = sigma_r[i] = -1;
}
for (n = 0; n < calls; n++)
{
double fval;
unsigned int j = (n/2) % dim;
unsigned int side = (n % 2);
for (i = 0; i < dim; i++)
{
double z = gsl_rng_uniform_pos (r) ;
if (i != j)
{
x[i] = xl[i] + z * (xu[i] - xl[i]);
}
else
{
if (side == 0)
{
x[i] = xmid[i] + z * (xu[i] - xmid[i]);
}
else
{
x[i] = xl[i] + z * (xmid[i] - xl[i]);
}
}
}
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));
}
/* compute the variances on each side of the bisection */
for (i = 0; i < dim; i++)
{
if (x[i] <= xmid[i])
{
fsum_l[i] += fval;
fsum2_l[i] += fval * fval;
hits_l[i]++;
}
else
{
fsum_r[i] += fval;
fsum2_r[i] += fval * fval;
hits_r[i]++;
}
}
}
for (i = 0; i < dim; i++)
{
double fraction_l = (xmid[i] - xl[i]) / (xu[i] - xl[i]);
if (hits_l[i] > 0)
{
fsum_l[i] /= hits_l[i];
sigma_l[i] = sqrt (fsum2_l[i] - fsum_l[i] * fsum_l[i] / hits_l[i]);
sigma_l[i] *= fraction_l * vol / hits_l[i];
}
if (hits_r[i] > 0)
{
fsum_r[i] /= hits_r[i];
sigma_r[i] = sqrt (fsum2_r[i] - fsum_r[i] * fsum_r[i] / hits_r[i]);
sigma_r[i] *= (1 - fraction_l) * vol / hits_r[i];
}
}
*result = vol * m;
if (calls < 2)
{
*abserr = GSL_POSINF;
}
else
{
*abserr = vol * sqrt (q / (calls * (calls - 1.0)));
}
return GSL_SUCCESS;
}
int
gsl_monte_vegas_integrate (gsl_monte_function * f,
double xl[], double xu[],
size_t dim, size_t calls,
gsl_rng * r,
gsl_monte_vegas_state * state,
double *result, double *abserr)
{
double cum_int, cum_sig;
size_t i, k, it;
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->stage == 0)
{
init_grid (state, xl, xu, dim);
if (state->verbose >= 0)
{
print_lim (state, xl, xu, dim);
}
}
if (state->stage <= 1)
{
state->wtd_int_sum = 0;
state->sum_wgts = 0;
state->chi_sum = 0;
state->it_num = 1;
state->samples = 0;
state->chisq = 0;
}
if (state->stage <= 2)
{
unsigned int bins = state->bins_max;
unsigned int boxes = 1;
if (state->mode != GSL_VEGAS_MODE_IMPORTANCE_ONLY)
{
/* shooting for 2 calls/box */
boxes = floor (pow (calls / 2.0, 1.0 / dim));
state->mode = GSL_VEGAS_MODE_IMPORTANCE;
if (2 * boxes >= state->bins_max)
{
/* if bins/box < 2 */
int box_per_bin = GSL_MAX (boxes / state->bins_max, 1);
bins = GSL_MIN(boxes / box_per_bin, state->bins_max);
boxes = box_per_bin * bins;
state->mode = GSL_VEGAS_MODE_STRATIFIED;
}
}
{
double tot_boxes = gsl_pow_int ((double) boxes, dim);
state->calls_per_box = GSL_MAX (calls / tot_boxes, 2);
calls = state->calls_per_box * tot_boxes;
}
/* total volume of x-space/(avg num of calls/bin) */
state->jac = state->vol * pow ((double) bins, (double) dim) / calls;
state->boxes = boxes;
/* If the number of bins changes from the previous invocation, bins
are expanded or contracted accordingly, while preserving bin
density */
if (bins != state->bins)
{
resize_grid (state, bins);
if (state->verbose > 1)
{
print_grid (state, dim);
}
}
if (state->verbose >= 0)
{
print_head (state,
dim, calls, state->it_num, state->bins, state->boxes);
}
}
state->it_start = state->it_num;
cum_int = 0.0;
cum_sig = 0.0;
for (it = 0; it < state->iterations; it++)
{
double intgrl = 0.0, intgrl_sq = 0.0;
double tss = 0.0;
double wgt, var, sig;
size_t calls_per_box = state->calls_per_box;
double jacbin = state->jac;
double *x = state->x;
coord *bin = state->bin;
state->it_num = state->it_start + it;
reset_grid_values (state);
init_box_coord (state, state->box);
do
{
volatile double m = 0, q = 0;
double f_sq_sum = 0.0;
for (k = 0; k < calls_per_box; k++)
{
volatile double fval;
double bin_vol;
random_point (x, bin, &bin_vol, state->box, xl, xu, state, r);
fval = jacbin * bin_vol * GSL_MONTE_FN_EVAL (f, x);
/* recurrence for mean and variance (sum of squares) */
{
double d = fval - m;
m += d / (k + 1.0);
q += d * d * (k / (k + 1.0));
}
if (state->mode != GSL_VEGAS_MODE_STRATIFIED)
{
double f_sq = fval * fval;
accumulate_distribution (state, bin, f_sq);
}
}
intgrl += m * calls_per_box;
f_sq_sum = q * calls_per_box;
tss += f_sq_sum;
if (state->mode == GSL_VEGAS_MODE_STRATIFIED)
{
accumulate_distribution (state, bin, f_sq_sum);
}
}
while (change_box_coord (state, state->box));
/* Compute final results for this iteration */
var = tss / (calls_per_box - 1.0) ;
if (var > 0)
{
wgt = 1.0 / var;
}
else if (state->sum_wgts > 0)
{
wgt = state->sum_wgts / state->samples;
}
else
{
wgt = 0.0;
}
intgrl_sq = intgrl * intgrl;
sig = sqrt (var);
state->result = intgrl;
state->sigma = sig;
if (wgt > 0.0)
{
double sum_wgts = state->sum_wgts;
double wtd_int_sum = state->wtd_int_sum;
double m = (sum_wgts > 0) ? (wtd_int_sum / sum_wgts) : 0;
double q = intgrl - m;
state->samples++ ;
state->sum_wgts += wgt;
state->wtd_int_sum += intgrl * wgt;
state->chi_sum += intgrl_sq * wgt;
cum_int = state->wtd_int_sum / state->sum_wgts;
cum_sig = sqrt (1 / state->sum_wgts);
#if USE_ORIGINAL_CHISQ_FORMULA
/* This is the chisq formula from the original Lepage paper. It
computes the variance from <x^2> - <x>^2 and can suffer from
catastrophic cancellations, e.g. returning negative chisq. */
if (state->samples > 1)
{
state->chisq = (state->chi_sum - state->wtd_int_sum * cum_int) /
(state->samples - 1.0);
}
#else
/* The new formula below computes exactly the same quantity as above
but using a stable recurrence */
if (state->samples == 1) {
state->chisq = 0;
} else {
state->chisq *= (state->samples - 2.0);
state->chisq += (wgt / (1 + (wgt / sum_wgts))) * q * q;
state->chisq /= (state->samples - 1.0);
}
#endif
}
else
{
cum_int += (intgrl - cum_int) / (it + 1.0);
cum_sig = 0.0;
}
if (state->verbose >= 0)
{
print_res (state,
state->it_num, intgrl, sig, cum_int, cum_sig,
state->chisq);
if (it + 1 == state->iterations && state->verbose > 0)
{
print_grid (state, dim);
}
}
if (state->verbose > 1)
{
print_dist (state, dim);
}
refine_grid (state);
if (state->verbose > 1)
{
print_grid (state, dim);
}
}
/* By setting stage to 1 further calls will generate independent
estimates based on the same grid, although it may be rebinned. */
state->stage = 1;
*result = cum_int;
*abserr = cum_sig;
return GSL_SUCCESS;
}
