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_plain_state* s = gsl_monte_plain_alloc(ndim);
gsl_monte_plain_integrate(&G,xl,xu,ndim,calls,r,s,integral,error);
gsl_monte_plain_free(s);
gsl_rng_free(r);
return 0; // succes!
}
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));
}
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);
}
}
double probability_an_bn1(protocol_params_t *p)
{
static pthread_mutex_t hash_mutex = PTHREAD_MUTEX_INITIALIZER;
static struct hashtable *hash_table = NULL;
hashkey_t *hash_key;
double *hash_res;
pthread_mutex_lock(&hash_mutex);
if (hash_table == NULL)
hash_table = create_hashtable(16, key_hash, key_equal, &hash_mutex);
pthread_mutex_unlock(&hash_mutex);
hash_key = create_key_protocol_nk(p, 1, 0);
hash_res = hashtable_search(hash_table, hash_key);
if (hash_res != NULL) {
free(hash_key);
return *hash_res;
}
double xl[] = {
p->tau,
0,
2 * M_PI
};
double xu[] = {
p->on - p->lambda,
2 * M_PI - p->on,
4 * M_PI - p->on
};
double res, err;
gsl_monte_function F ={
.f = &integrand_n_n1,
.dim = 3,
.params = p
};
gsl_monte_plain_state *s;
const gsl_rng_type *T;
gsl_rng *r;
T = gsl_rng_default;
r = gsl_rng_alloc(T);
s = gsl_monte_plain_alloc(F.dim);
gsl_monte_plain_integrate(&F, xl, xu, F.dim, CALLS, r, s, &res, &err);
gsl_monte_plain_free(s);
hash_res = malloc(sizeof(double));
*hash_res = res;
hashtable_insert(hash_table, hash_key, hash_res);
return res;
}
double probability_a0_bm1(protocol_params_t *p)
{
#ifdef CONTACT_VARIABLE
double result = (2 * M_PI + p->on - 2 * p->lambda) / 4 / M_PI;
#else
double result = 1.;
#endif
return result * probability_an_bn1(p);
}
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;
}