#include <gsl/gsl_qrng.h>
#include <R.h>
#include <Rdefines.h>

/* function names generated by removing  "gsl_" from the beginning
   of the name.  Thus gsl_qrng_alloc goes
   to qrng_alloc. */

/* type 0 is gsl_qrng_niederreiter_2, type 1 is gsl_qrng_sobol */

static void cleanup(SEXP r)
{
	gsl_qrng_free((gsl_qrng*)EXTPTR_PTR(r));
}
	
SEXP qrng_alloc(SEXP type, SEXP dimension) 
{
	const gsl_qrng_type * T = NULL;
	SEXP result;

	switch(asInteger(type)) {
	case 0: 
		T = gsl_qrng_niederreiter_2;
		break;
	case 1: T = gsl_qrng_sobol;
		break;
	default:
		error("unknown QRNG type");
	};
	PROTECT(dimension = AS_INTEGER(dimension));
	result = R_MakeExternalPtr(gsl_qrng_alloc(T, (unsigned int)asInteger(dimension)),
				   dimension, R_NilValue);
	UNPROTECT(1);
	R_RegisterCFinalizer(result, cleanup);
	return result;
}  

SEXP qrng_clone(SEXP r)
{
	SEXP result;
	gsl_qrng *gen = NULL;
	
	if (TYPEOF(r) != EXTPTRSXP || !(gen = (gsl_qrng*)EXTPTR_PTR(r))) 
		error("not a QRNG generator");
	result = R_MakeExternalPtr(gsl_qrng_clone(gen),
				   PROTECT(duplicate(EXTPTR_TAG(r))), R_NilValue);
	UNPROTECT(1);
	R_RegisterCFinalizer(result, cleanup);
	return result;
}

SEXP qrng_init(SEXP r)
{
	gsl_qrng *gen = NULL;
	
	if (TYPEOF(r) != EXTPTRSXP || !(gen = (gsl_qrng*)EXTPTR_PTR(r))) 
		error("not a QRNG generator");
	gsl_qrng_init(gen);
	return r;
}

SEXP qrng_name(SEXP r)
{
	gsl_qrng *gen = NULL;
	
	if (TYPEOF(r) != EXTPTRSXP || !(gen = (gsl_qrng*)EXTPTR_PTR(r))) 
		error("not a QRNG generator");
	return mkString(gsl_qrng_name(gen));
}

SEXP qrng_size(SEXP r)
{
	gsl_qrng *gen = NULL;
	
	if (TYPEOF(r) != EXTPTRSXP || !(gen = (gsl_qrng*)EXTPTR_PTR(r))) 
		error("not a QRNG generator");
		
	return ScalarInteger(gsl_qrng_size(gen));
}

SEXP qrng_state(SEXP r)
{
	gsl_qrng *gen = NULL;
	
	if (TYPEOF(r) != EXTPTRSXP || !(gen = (gsl_qrng*)EXTPTR_PTR(r))) 
		error("not a QRNG generator");
		
	return R_MakeExternalPtr(gsl_qrng_state(gen),
				 R_NilValue, R_NilValue);
}

SEXP qrng_get(SEXP r)
{
	SEXP result;
	gsl_qrng *gen = NULL;
	int dim;
	
	if (TYPEOF(r) != EXTPTRSXP || !(gen = (gsl_qrng*)EXTPTR_PTR(r))) 
		error("not a QRNG generator");
		
	dim = asInteger(EXTPTR_TAG(r));	
	result = PROTECT(NEW_NUMERIC(dim));
	if (gsl_qrng_get(gen, REAL(result)) != GSL_SUCCESS)
		error("QRNG generator failed");
	UNPROTECT(1);
	return result;
}	

SEXP get_n(SEXP r, SEXP n)
{
	SEXP result;
	gsl_qrng *gen = NULL;
	double *value;
	int i, dim, num = asInteger(n);
	
	if (TYPEOF(r) != EXTPTRSXP || !(gen = (gsl_qrng*)EXTPTR_PTR(r)))
		error("not a QRNG generator");
		
	dim = asInteger(EXTPTR_TAG(r));	
	result = PROTECT(NEW_NUMERIC(dim*num));
	value = REAL(result);
	
	for (i=0; i<num; i++) {
		if (gsl_qrng_get(gen, value) != GSL_SUCCESS)
			error("QRNG generator failed");
		value += dim;
	}
	UNPROTECT(1);
	return result;
}
