Example #1
0
    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!
        }
Example #2
0
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(&params->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);
	}
}
Example #4
0
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);
}
Example #5
0
 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;
 }