CAMLprim value ml_gsl_qrng_sample(value qrng)
{
gsl_qrng * q = Qrng_val(qrng);
value arr = alloc(q->dimension * Double_wosize, Double_array_tag);
gsl_qrng_get(q, Double_array_val(arr));
return arr;
}
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;
}
static VALUE rb_gsl_qrng_get(int argc, VALUE *argv, VALUE obj)
{
gsl_qrng *q = NULL;
gsl_vector *v;
Data_Get_Struct(obj, gsl_qrng, q);
if (argc == 0) {
v = gsl_vector_alloc(q->dimension);
gsl_qrng_get(q, v->data);
return Data_Wrap_Struct(cgsl_vector, 0, gsl_vector_free, v);
} else {
if (!rb_obj_is_kind_of(argv[0], cgsl_vector)) {
rb_raise(rb_eArgError, "wrong type argument (GSL_Vector required)");
}
Data_Get_Struct(argv[0], gsl_vector, v);
return INT2FIX(gsl_qrng_get(q, v->data));
}
}
int quasi_monte_integrate(gsl_monte_function* f, const double xl[], const double xu[], size_t dim, size_t max_calls, double max_relerr, double max_abserr, gsl_qrng* r, quasi_monte_state* state, double* result, double* abserr) {
double volume = 1, mean = 0, variance_sum = 0, running_avg_abserr = GSL_POSINF;
double* x = state->x;
size_t n, i;
// Check that the dimensionalities match
if (dim != state->dim) {
char errmsg[80];
snprintf(errmsg, 80, "number of dimensions %ud doesn't match allocated size %ud", (unsigned int)dim, (unsigned int)(state->dim));
GSL_ERROR(errmsg, GSL_EINVAL);
}
// Check the bounds for validity
for (i = 0; i < dim; i++) {
if (xu[i] <= xl[i]) {
char errmsg[80];
snprintf(errmsg, 80, "lower limit %f not less than upper limit %f", xl[i], xu[i]);
GSL_ERROR(errmsg, GSL_EINVAL);
}
if (xu[i] - xl[i] > GSL_DBL_MAX) {
char errmsg[80];
snprintf(errmsg, 80, "integration range (%f,%f) is larger than limit %f", xl[i], xu[i], GSL_DBL_MAX);
GSL_ERROR(errmsg, GSL_EINVAL);
}
}
// Compute the volume of the region
for (i = 0; i < dim; i++) {
volume *= xu[i] - xl[i];
}
for (n = 0; n < max_calls; n++) {
// Choose a quasirandom point in the integration region
gsl_qrng_get(r, x);
for (i = 0; i < dim; i++) {
x[i] = xl[i] + (xu[i] - xl[i]) * x[i];
}
{
double fval = GSL_MONTE_FN_EVAL(f, x);
double d = fval - mean;
mean += d / (n + 1.0);
variance_sum += d * d * (n / (n + 1.0));
}
if (n > 1) {
running_avg_abserr = sqrt(variance_sum / ((n + 1.0) * n));
if (volume * running_avg_abserr < max_abserr) {
break;
}
if (fabs(running_avg_abserr / mean) < max_relerr) {
break;
}
}
}
*result = volume * mean;
*abserr = volume * running_avg_abserr;
return GSL_SUCCESS;
}
int
main ()
{
int i;
gsl_qrng * q = gsl_qrng_alloc (gsl_qrng_sobol, 2);
for (i = 0; i < 1024; i++)
{
double v[2];
gsl_qrng_get(q, v);
printf("%.5f %.5f\n", v[0], v[1]);
}
gsl_qrng_free(q);
}
static PyObject*
SobolSampler_iternext(PyObject *self)
{
SobolSampler* s = (SobolSampler *)self;
if (s->_size == 0)
{
PyErr_SetNone(PyExc_StopIteration);
return NULL;
}
int arr_dims[1] = {s->_dims};
PyArrayObject* arr = (PyArrayObject *)PyArray_SimpleNew(1 /*nd*/, arr_dims, NPY_DOUBLE);
if (!arr) return NULL;
gsl_qrng_get(s->_rng, (double *)PyArray_DATA(arr));
if (!s->_is_inf) --s->_size;
return PyArray_Return(arr);
}
std::vector<double> npQuasiRandom::operator ()() {
std::vector<double> vec(dim);
gsl_qrng_get(qran, &vec[0]);
return vec;
}
void test_sobol(void)
{
int status = 0;
double v[3];
/* int i; */
/* test in dimension 2 */
gsl_qrng * g = gsl_qrng_alloc(gsl_qrng_sobol, 2);
gsl_qrng_get(g, v);
gsl_qrng_get(g, v);
gsl_qrng_get(g, v);
status += ( v[0] != 0.25 || v[1] != 0.75 );
gsl_qrng_get(g, v);
status += ( v[0] != 0.375 || v[1] != 0.375 );
gsl_qrng_free(g);
gsl_test (status, "Sobol d=2");
status = 0;
/* test in dimension 3 */
g = gsl_qrng_alloc(gsl_qrng_sobol, 3);
gsl_qrng_get(g, v);
gsl_qrng_get(g, v);
gsl_qrng_get(g, v);
status += ( v[0] != 0.25 || v[1] != 0.75 || v[2] != 0.25 );
gsl_qrng_get(g, v);
status += ( v[0] != 0.375 || v[1] != 0.375 || v[2] != 0.625 );
gsl_test (status, "Sobol d=3");
status = 0;
gsl_qrng_init(g);
gsl_qrng_get(g, v);
gsl_qrng_get(g, v);
gsl_qrng_get(g, v);
status += ( v[0] != 0.25 || v[1] != 0.75 || v[2] != 0.25 );
gsl_qrng_get(g, v);
status += ( v[0] != 0.375 || v[1] != 0.375 || v[2] != 0.625 );
gsl_qrng_free(g);
gsl_test (status, "Sobol d=3 (reinitialized)");
}
void test_nied2(void)
{
int status = 0;
double v[3];
/* int i; */
/* test in dimension 2 */
gsl_qrng * g = gsl_qrng_alloc(gsl_qrng_niederreiter_2, 2);
gsl_qrng_get(g, v);
gsl_qrng_get(g, v);
gsl_qrng_get(g, v);
status += ( v[0] != 0.75 || v[1] != 0.25 );
gsl_qrng_get(g, v);
status += ( v[0] != 0.25 || v[1] != 0.75 );
gsl_qrng_get(g, v);
gsl_qrng_get(g, v);
gsl_qrng_get(g, v);
status += ( v[0] != 0.625 || v[1] != 0.125 );
gsl_qrng_free(g);
gsl_test (status, "Niederreiter d=2");
status = 0;
/* test in dimension 3 */
g = gsl_qrng_alloc(gsl_qrng_niederreiter_2, 3);
gsl_qrng_get(g, v);
gsl_qrng_get(g, v);
gsl_qrng_get(g, v);
status += ( v[0] != 0.75 || v[1] != 0.25 || v[2] != 0.3125 );
gsl_qrng_get(g, v);
status += ( v[0] != 0.25 || v[1] != 0.75 || v[2] != 0.5625 );
gsl_qrng_get(g, v);
gsl_qrng_get(g, v);
gsl_qrng_get(g, v);
status += ( v[0] != 0.625 || v[1] != 0.125 || v[2] != 0.6875 );
gsl_test (status, "Niederreiter d=3");
status = 0;
gsl_qrng_init(g);
gsl_qrng_get(g, v);
gsl_qrng_get(g, v);
gsl_qrng_get(g, v);
status += ( v[0] != 0.75 || v[1] != 0.25 || v[2] != 0.3125 );
gsl_qrng_get(g, v);
status += ( v[0] != 0.25 || v[1] != 0.75 || v[2] != 0.5625 );
gsl_qrng_get(g, v);
gsl_qrng_get(g, v);
gsl_qrng_get(g, v);
status += ( v[0] != 0.625 || v[1] != 0.125 || v[2] != 0.6875 );
gsl_qrng_free(g);
gsl_test (status, "Niederreiter d=3 (reinitialized)");
}
