double
gsl_ran_tdist (const gsl_rng * r, const double nu)
{
if (nu <= 2)
{
double Y1 = gsl_ran_ugaussian (r);
double Y2 = gsl_ran_chisq (r, nu);
double t = Y1 / sqrt (Y2 / nu);
return t;
}
else
{
double Y1, Y2, Z, t;
do
{
Y1 = gsl_ran_ugaussian (r);
Y2 = gsl_ran_exponential (r, 1 / (nu/2 - 1));
Z = Y1 * Y1 / (nu - 2);
}
while (1 - Z < 0 || exp (-Y2 - Z) > (1 - Z));
/* Note that there is a typo in Knuth's formula, the line below
is taken from the original paper of Marsaglia, Mathematics of
Computation, 34 (1980), p 234-256 */
t = Y1 / sqrt ((1 - 2 / nu) * (1 - Z));
return t;
}
}
int main(void) {
const gsl_rng_type * T;
gsl_rng * r;
struct data ntuple_row;
int i;
gsl_ntuple *ntuple = gsl_ntuple_create("test.dat", &ntuple_row,
sizeof(ntuple_row));
gsl_rng_env_setup();
T = gsl_rng_default;
r = gsl_rng_alloc(T);
for (i = 0; i < 10000; i++) {
ntuple_row.x = gsl_ran_ugaussian(r);
ntuple_row.y = gsl_ran_ugaussian(r);
ntuple_row.z = gsl_ran_ugaussian(r);
gsl_ntuple_write(ntuple);
}
gsl_ntuple_close(ntuple);
gsl_rng_free(r);
return EXIT_SUCCESS;
}
int main(int argc, char **argv) {
int M = atoi(argv[1]);
int N = atoi(argv[2]);
printf("%d %d\n", M, N);
gsl_rng *rng;
const gsl_rng_type *rngType;
gsl_rng_env_setup();
rngType = gsl_rng_default;
rng = gsl_rng_alloc(rngType);
gsl_matrix *A = gsl_matrix_alloc(M, N);
int i = 0;
int j = 0;
for (i = 0; i < M; i++)
#pragma omp parallel for
for (j = 0; j < N; j++)
gsl_matrix_set(A, i, j, gsl_ran_ugaussian(rng));
double *A1 = (double*) A;
printf("%e\n", A1[(xkM*N/2)]);
return 0;
}
void make_random_unit_quaternion(gsl_vector *Q, gsl_rng *rng)
{
/* This comes from Graphics Gems III p. 129. */
for (size_t i = 0; i < 4; i++)
gsl_vector_set(Q, i, gsl_ran_ugaussian(rng));
vector_normalize(Q);
}
int main (int argc, char **argv) {
int i;
const gsl_rng_type *rngType;
gsl_rng *rng;
gsl_rng_env_setup();
rngType = gsl_rng_default;
rng = gsl_rng_alloc(rngType);
double a[16];
for (i = 0; i < 16; i++) {
a[i] = gsl_ran_ugaussian(rng);
printf("%e\n", a[i]);
}
double z[30];
gsl_poly_complex_workspace *w = gsl_poly_complex_workspace_alloc(16);
gsl_poly_complex_solve(a, 16, w, z);
gsl_poly_complex_workspace_free(w);
for (i = 0; i < 30; i++) {
printf("z%d = %+.18f %+.18f\n", i, z[2*i], z[2*i+1]);
}
gsl_rng_free(rng);
return 0;
}
int rmvnorm(const gsl_rng *r, const int n, const gsl_vector *mean,
const gsl_matrix *var, gsl_vector *result){
/* multivariate normal distribution random number generator */
/*
* n dimension of the random vetor
* mean vector of means of size n
* var variance matrix of dimension n x n
* result output variable with a sigle random vector normal distribution generation
*/
int k;
gsl_matrix *work = gsl_matrix_alloc(n,n);
gsl_matrix_memcpy(work,var);
gsl_linalg_cholesky_decomp(work);
for(k=0; k<n; k++)
gsl_vector_set( result, k, gsl_ran_ugaussian(r) );
gsl_blas_dtrmv(CblasLower, CblasNoTrans, CblasNonUnit, work, result );
gsl_vector_add(result,mean);
gsl_matrix_free(work);
return 0;
}
/* Generate a random vector from a multivariate Gaussian distribution using
* the Cholesky decomposition of the variance-covariance matrix, following
* "Computational Statistics" from Gentle (2009), section 7.4.
*
* mu mean vector (dimension d)
* L matrix resulting from the Cholesky decomposition of
* variance-covariance matrix Sigma = L L^T (dimension d x d)
* result output vector (dimension d)
*/
int
gsl_ran_multivariate_gaussian (const gsl_rng * r,
const gsl_vector * mu,
const gsl_matrix * L,
gsl_vector * result)
{
const size_t M = L->size1;
const size_t N = L->size2;
if (M != N)
{
GSL_ERROR("requires square matrix", GSL_ENOTSQR);
}
else if (mu->size != M)
{
GSL_ERROR("incompatible dimension of mean vector with variance-covariance matrix", GSL_EBADLEN);
}
else if (result->size != M)
{
GSL_ERROR("incompatible dimension of result vector", GSL_EBADLEN);
}
else
{
size_t i;
for (i = 0; i < M; ++i)
gsl_vector_set(result, i, gsl_ran_ugaussian(r));
gsl_blas_dtrmv(CblasLower, CblasNoTrans, CblasNonUnit, L, result);
gsl_vector_add(result, mu);
return GSL_SUCCESS;
}
}
static void
_ncm_data_gauss_cov_resample (NcmData *data, NcmMSet *mset, NcmRNG *rng)
{
NcmDataGaussCov *gauss = NCM_DATA_GAUSS_COV (data);
NcmDataGaussCovClass *gauss_cov_class = NCM_DATA_GAUSS_COV_GET_CLASS (gauss);
gboolean cov_update = FALSE;
gint ret;
guint i;
if (gauss_cov_class->cov_func != NULL)
cov_update = gauss_cov_class->cov_func (gauss, mset, gauss->cov);
if (cov_update || !gauss->prepared_LLT)
_ncm_data_gauss_cov_prepare_LLT (data);
ncm_rng_lock (rng);
for (i = 0; i < gauss->np; i++)
{
const gdouble u_i = gsl_ran_ugaussian (rng->r);
ncm_vector_set (gauss->v, i, u_i);
}
ncm_rng_unlock (rng);
/* CblasLower, CblasNoTrans => CblasUpper, CblasTrans */
ret = gsl_blas_dtrmv (CblasUpper, CblasTrans, CblasNonUnit,
ncm_matrix_gsl (gauss->LLT), ncm_vector_gsl (gauss->v));
NCM_TEST_GSL_RESULT ("_ncm_data_gauss_cov_resample", ret);
gauss_cov_class->mean_func (gauss, mset, gauss->y);
ncm_vector_sub (gauss->y, gauss->v);
}
void gsl_vector_step_random(const gsl_rng* r, gsl_vector* v,
const double step_size)
{
const size_t n = v->size;
gsl_vector* vp = gsl_vector_alloc(n);
// Set normal distributed random numbers as elements of v_new and
// compute the euclidean norm of this vector.
double length = 0.;
for (size_t i = 0; i < n; ++i)
{
double* vp_i = gsl_vector_ptr(vp, i);
*vp_i = gsl_ran_ugaussian(r);
length += pow(*vp_i, 2);
}
length = sqrt(length);
// Scale vp so that the elements of vp are uniformly distributed
// within an n-sphere of radius step_size.
const double scale = pow(pow(step_size, boost::numeric_cast<int>(n))
* gsl_rng_uniform_pos(r), 1.0/n) / length;
gsl_vector_scale(vp, scale);
gsl_vector_add(v, vp);
}
int main(int argc, char **argv) {
int M = atoi(argv[1]);
int N = atoi(argv[2]);
gsl_rng *rng;
const gsl_rng_type *rngType;
gsl_rng_env_setup();
rngType = gsl_rng_default;
rng = gsl_rng_alloc(rngType);
gsl_matrix *A = gsl_matrix_alloc(M, N);
int i = 0;
int j = 0;
for (i = 0; i < M; i++)
for (j = 0; j < N; j++)
gsl_matrix_set(A, i, j, gsl_ran_ugaussian(rng));
gsl_matrix *U = gsl_matrix_alloc(max(M,N), min(M,N));
gsl_vector *s = gsl_vector_alloc(min(M, N));
gsl_matrix *V = gsl_matrix_alloc(min(M, N), N);
if (!(gsl_clapack_dgesdd_(A, U, s, V) == 0))
printf("Error!\n");
printf("%e\n", gsl_matrix_get(U, 20, 20));
gsl_rng_free(rng);
return 0;
}
void gaussian_gen(const gsl_rng* rng, const gaussian_t* dist,
gsl_vector* result) {
assert(result->size == dist->dim);
size_t i;
for (i = 0; i < result->size; i++) {
gsl_vector_set(result, i, gsl_ran_ugaussian(rng));
}
if (gaussian_isdiagonal(dist)) {
for (i = 0; i < result->size; i++) {
double* p = gsl_vector_ptr(result, i);
*p *= DEBUG_SQRT(gsl_vector_get(dist->diag, i));
}
}
else {
gsl_matrix* v = gsl_matrix_alloc(dist->dim, dist->dim);
gsl_matrix_memcpy(v, dist->cov);
gsl_linalg_cholesky_decomp(v);
gsl_blas_dtrmv(CblasLower, CblasNoTrans, CblasNonUnit, v, result);
gsl_matrix_free(v);
}
gsl_vector_add(result, dist->mean);
}
double* gsl_runorm(gsl_rng *r, const int n) {
double *x = malloc(n * sizeof(double));
#pragma omp parallel for schedule(static), num_threads(2)
for (int i = 0; i < n; i++) {
x[i] = gsl_ran_ugaussian(r);
}
return x;
};
void RandomNumberGenerator::gaussian_mv(const vector<double> &mean, const vector<vector<double> > &covar, const vector<double> &min, const vector<double> &max, vector<double> &result){
/* multivariate normal distribution random number generator */
/*
* n dimension of the random vetor
* mean vector of means of size n
* var variance matrix of dimension n x n
* result output variable with a sigle random vector normal distribution generation
*/
int k;
int n=mean.size();
gsl_matrix *_covar = gsl_matrix_alloc(covar.size(),covar[0].size());
gsl_vector *_result = gsl_vector_calloc(mean.size());
gsl_vector *_mean = gsl_vector_calloc(mean.size());
result.resize(mean.size());
for(k=0;k<n;k++){
for(int j=0;j<n;j++){
gsl_matrix_set(_covar,k,j,covar[k][j]);
}
gsl_vector_set(_mean, k, mean[k]);
}
int status = gsl_linalg_cholesky_decomp(_covar);
if(status){
printf("ERROR: Covariance matrix appears to be un-invertible. Increase your convergence step length to better sample the posterior such that you have enough samples to create a non-singular matrix at first matrix update.\nExiting...\n");
exit(1);
}
bool in_range;
do{
for(k=0; k<n; k++)
gsl_vector_set( _result, k, gsl_ran_ugaussian(r) );
gsl_blas_dtrmv(CblasLower, CblasNoTrans, CblasNonUnit, _covar, _result);
gsl_vector_add(_result,_mean);
in_range = true;
for(k=0; k<n; k++){
if(gsl_vector_get(_result, k) < min[k] or gsl_vector_get(_result, k) > max[k]){
in_range = false;
k=n+1;
}
}
}while(not in_range);
for(k=0; k<n; k++){
result[k] = gsl_vector_get(_result, k);
}
gsl_matrix_free(_covar);
gsl_vector_free(_result);
gsl_vector_free(_mean);
return;
}
int main(int argc, char** argv) {
const gsl_rng_type *rngType;
gsl_rng_env_setup();
rngType = gsl_rng_default;
rng = gsl_rng_alloc(rngType);
int matrixSize1 = atoi(argv[1]);
int matrixSize2 = atoi(argv[2]);
#ifdef DEBUG
printf("%5d %5d\n", matrixSize1, matrixSize2);
#endif
gsl_matrix *dataSet = gsl_matrix_alloc(matrixSize1, matrixSize2);
int i = 0;
int j = 0;
#ifdef DEBUG
printf("Generating.......");
#endif
for (i= 0; i < matrixSize1; i++) {
for (j = 0; j < matrixSize2; j++) {
gsl_matrix_set(dataSet, i, j, gsl_ran_ugaussian(rng));
#ifdef DEBUG
printf("%e\n", gsl_matrix_get(dataSet, i, j));
#endif
}
}
#ifdef DEBUG
printf("OK!\n");
#endif
gsl_matrix *svdVmatrix = gsl_matrix_alloc(matrixSize2, matrixSize2);
gsl_vector *svdSvector = gsl_vector_alloc(matrixSize2);
gsl_vector *svdWorkspace = gsl_vector_alloc(matrixSize2);
#ifdef DEBUG
for (j = 0; j < matrixSize2; j++) printf("%e\n", gsl_matrix_get(dataSet, 5, j));
#endif
if (!(gsl_linalg_SV_decomp(dataSet, svdVmatrix, svdSvector, svdWorkspace) == 0))
printf("Error!\n");
gsl_rng_free(rng);
return 0;
}
void runTrial(int T, double mu, double sigma, double deltat, gsl_rng* r,int n){
std::ofstream file;
if(n==1)
file.open("task10_t1.dat");
if(n==2)
file.open("task10_t2.dat");
int M=T/deltat;
double w1[M+1], w2[M+1], w3[M+1],s1[M+1], s2[M+1], s3[M+1];
s1[0]=10;
s2[0]=10;
s3[0]=10;
w1[0]=gsl_ran_ugaussian(r);
w2[0]=gsl_ran_ugaussian(r);
w3[0]=gsl_ran_ugaussian(r);
file << "#deltat w1 w2 w3 s1 s2 s3\n";
file << "0 " << w1[0]<< " " << w2[0] << " " << w3[0] << " " << s1[0] <<" " << s2[0] <<" " <<s3[0] <<" "<< "\n";
for(int i=1;i<=M;i++){
w1[i]=w1[i-1]+sqrt(i*deltat-(i-1)*deltat)*gsl_ran_ugaussian(r);
w2[i]=w2[i-1]+sqrt(i*deltat-(i-1)*deltat)*gsl_ran_ugaussian(r);
w3[i]=w3[i-1]+sqrt(i*deltat-(i-1)*deltat)*gsl_ran_ugaussian(r);
s1[i]=s1[0]*exp((mu-0.5*sigma*sigma)*i*deltat+sigma*w1[i]);
s2[i]=s2[0]*exp((mu-0.5*sigma*sigma)*i*deltat+sigma*w2[i]);
s3[i]=s3[0]*exp((mu-0.5*sigma*sigma)*i*deltat+sigma*w3[i]);
file << i*deltat << " " <<w1[i]<<" " <<w2[i]<<" " <<w3[i]<< " " << s1[i] <<" " << s2[i]<<" " << s3[i]<< "\n";
}
file.close();
}
int semirmvnorm(const gsl_rng *rnd, const unsigned int n, const gsl_matrix *Sigma, gsl_vector *randeffect)
{
unsigned int k, r=0;
double lambda;
gsl_matrix *work = gsl_matrix_alloc(n,n);
gsl_matrix_memcpy(work, Sigma);
// replace cholesky with eigen decomposition
gsl_eigen_symmv_workspace * w = gsl_eigen_symmv_alloc (n);
gsl_vector *eval=gsl_vector_alloc (n);
gsl_matrix *evec=gsl_matrix_alloc (n, n);
// work = evec*diag(eval)*t(evec)
gsl_eigen_symmv (work, eval, evec, w);
// displayvector (eval, "eigen values of work");
// displaymatrix (evec, "eigen vector of work");
for (k=0; k<n; k++) {
gsl_vector_view evec_i=gsl_matrix_column(evec, k);
lambda=gsl_vector_get(eval, k);
if (lambda>10e-10){ // non-zero variables
// U = t(eval(r)*evec(:, r))
gsl_vector_scale (&evec_i.vector, sqrt(lambda));
// copy U to work
gsl_matrix_set_col(work, r, &evec_i.vector);
r++;
}
}
// printf("r=%d.\n", r);
gsl_matrix_view U=gsl_matrix_submatrix (work, 0, 0, n, r);
// displaymatrix (&U.matrix, "partial eigen vectors");
// generate standard normal vector
gsl_vector *z=gsl_vector_alloc(r);
for(k=0; k<r; k++)
gsl_vector_set( z, k, gsl_ran_ugaussian(rnd) );
// displayvector (z, "z");
// X_i = mu_i + t(U)*z
gsl_blas_dgemv (CblasNoTrans, 1.0, &U.matrix, z, 0.0, randeffect);
// displayvector (randeffect, "randeffect");
gsl_matrix_free(work);
gsl_eigen_symmv_free(w);
gsl_matrix_free(evec);
gsl_vector_free(eval);
gsl_vector_free(z);
return 0;
}
int rwishart(const gsl_rng *r, const unsigned int n, const unsigned int dof, const gsl_matrix *scale, gsl_matrix *result)
{
unsigned int k,l;
gsl_matrix *work = gsl_matrix_calloc(n,n);
for(k=0; k<n; k++){
gsl_matrix_set( work, k, k, sqrt( gsl_ran_chisq( r, (dof-k) ) ) );
for(l=0; l<k; l++)
gsl_matrix_set( work, k, l, gsl_ran_ugaussian(r) );
}
gsl_matrix_memcpy(result,scale);
gsl_linalg_cholesky_decomp(result);
gsl_blas_dtrmm(CblasLeft,CblasLower,CblasNoTrans,CblasNonUnit,1.0,result,work);
gsl_blas_dsyrk(CblasUpper,CblasNoTrans,1.0,work,0.0,result);
return 0;
}
int rmvnorm(const gsl_rng *r, const unsigned int n, const gsl_matrix *Sigma, gsl_vector *randeffect)
{
unsigned int k;
gsl_matrix *work = gsl_matrix_alloc(n,n);
gsl_matrix_memcpy(work, Sigma);
gsl_linalg_cholesky_decomp(work);
for(k=0; k<n; k++)
gsl_vector_set(randeffect, k, gsl_ran_ugaussian(r) );
gsl_blas_dtrmv(CblasLower, CblasNoTrans, CblasNonUnit, work, randeffect);
gsl_matrix_free(work);
return 0;
}
double simulation(int T, int M, int S0, int K, double sigma, double r,gsl_rng* rng){
double w[M+1],s[M+1];
double dt=(double)T/M;
s[0]=S0;
w[0]=0;
double prod=1;
for(int i=1;i<=M;i++){
w[i]=w[i-1]+sqrt(dt)*gsl_ran_ugaussian(rng);
s[i]=s[0]*exp((r-0.5*sigma*sigma)*i*dt+sigma*w[i]);
prod*=s[i];
}
//printf("%f %f\n",prod,std::max(pow(prod,1./M)-K,(double)0));
return std::max(pow(prod,1./M)-K,(double)0);
}
void satellite(Halo const * const h, Particle* const g)
{
#ifdef DEBUG
assert(random_generator);
assert(solver);
#endif
const double a= 1.0/(1.0 + h->z);
const double rho_m= cosmology_rho_m()/(a*a*a); // physical [1/h Mpc]^-3
const double r200m= 1000.0*pow(h->M/(4.0*M_PI/3.0*200.0*rho_m), 1.0/3.0);
// physical 1/h kpc
const double c200m= r200m/h->rs;
//fprintf(stderr, "r200m c rs %e %e %e\n", r200m, c200m, h->rs);
// draw random mass M(r)/M0 between [0, f(c200m)]
const double fmax= f(c200m);
const double fx= fmax*gsl_rng_uniform(random_generator);
// solve for f(x) = fx, where x= r/r_s
double x= c200m*fx/fmax; // initial guess
x= f_inverse(fx, x);
double r_sat= x*h->rs; // location of the satellite from center
// compute vrms(r)
double vrms= compute_v_rms(r_sat, h->M, r200m, c200m);
r_sat= r_sat/(1000.0f*a); // physical /h kpc -> comoving /h Mpc
float e[3];
random_direction(e);
// satellite x v contains only offset from halo
g->x[0] = r_sat*e[0];
g->x[1] = r_sat*e[1];
g->x[2] = r_sat*e[2];
g->vr= vrms*gsl_ran_ugaussian(random_generator);
}
int rmvt(const gsl_rng *r, const unsigned int n, const gsl_vector *location, const gsl_matrix *scale, const unsigned int dof, gsl_vector *result)
{
unsigned int k;
gsl_matrix *work = gsl_matrix_alloc(n,n);
double ax = 0.5*dof;
ax = gsl_ran_gamma(r,ax,(1/ax)); /* gamma distribution */
gsl_matrix_memcpy(work,scale);
gsl_matrix_scale(work,(1/ax)); /* scaling the matrix */
gsl_linalg_cholesky_decomp(work);
for(k=0; k<n; k++)
gsl_vector_set( result, k, gsl_ran_ugaussian(r) );
gsl_blas_dtrmv(CblasLower, CblasNoTrans, CblasNonUnit, work, result);
gsl_vector_add(result, location);
gsl_matrix_free(work);
return 0;
}
/**
* Adapted from: Multivariate Normal density function and random
* number generator Using GSL from Ralph dos Santos Silva
* Copyright (C) 2006
* multivariate normal distribution random number generator
*
* @param n dimension of the random vetor
* @param mean vector of means of size n
* @param var variance matrix of dimension n x n
* @param result output variable with a sigle random vector normal distribution generation
*/
int ssm_rmvnorm(const gsl_rng *r, const int n, const gsl_vector *mean, const gsl_matrix *var, double sd_fac, gsl_vector *result)
{
int k;
gsl_matrix *work = gsl_matrix_alloc(n,n);
gsl_matrix_memcpy(work,var);
//scale var with sd_fac^2
gsl_matrix_scale(work, sd_fac*sd_fac);
gsl_linalg_cholesky_decomp(work);
for(k=0; k<n; k++)
gsl_vector_set( result, k, gsl_ran_ugaussian(r) );
gsl_blas_dtrmv(CblasLower, CblasNoTrans, CblasNonUnit, work, result);
gsl_vector_add(result,mean);
gsl_matrix_free(work);
return 0;
}
int
main (int argc, char *argv[])
{
size_t i,j;
size_t n = 0;
double mu = 0, nu = 0, nu1 = 0, nu2 = 0, sigma = 0, a = 0, b = 0, c = 0;
double zeta = 0, sigmax = 0, sigmay = 0, rho = 0;
double p = 0;
double x = 0, y =0, z=0 ;
unsigned int N = 0, t = 0, n1 = 0, n2 = 0 ;
unsigned long int seed = 0 ;
const char * name ;
gsl_rng * r ;
if (argc < 4)
{
printf (
"Usage: gsl-randist seed n DIST param1 param2 ...\n"
"Generates n samples from the distribution DIST with parameters param1,\n"
"param2, etc. Valid distributions are,\n"
"\n"
" beta\n"
" binomial\n"
" bivariate-gaussian\n"
" cauchy\n"
" chisq\n"
" dir-2d\n"
" dir-3d\n"
" dir-nd\n"
" erlang\n"
" exponential\n"
" exppow\n"
" fdist\n"
" flat\n"
" gamma\n"
" gaussian-tail\n"
" gaussian\n"
" geometric\n"
" gumbel1\n"
" gumbel2\n"
" hypergeometric\n"
" laplace\n"
" landau\n"
" levy\n"
" levy-skew\n"
" logarithmic\n"
" logistic\n"
" lognormal\n"
" negative-binomial\n"
" pareto\n"
" pascal\n"
" poisson\n"
" rayleigh-tail\n"
" rayleigh\n"
" tdist\n"
" ugaussian-tail\n"
" ugaussian\n"
" weibull\n") ;
exit (0);
}
argv++ ; seed = atol (argv[0]); argc-- ;
argv++ ; n = atol (argv[0]); argc-- ;
argv++ ; name = argv[0] ; argc-- ; argc-- ;
gsl_rng_env_setup() ;
if (gsl_rng_default_seed != 0) {
fprintf(stderr,
"overriding GSL_RNG_SEED with command line value, seed = %ld\n",
seed) ;
}
gsl_rng_default_seed = seed ;
r = gsl_rng_alloc(gsl_rng_default) ;
#define NAME(x) !strcmp(name,(x))
#define OUTPUT(x) for (i = 0; i < n; i++) { printf("%g\n", (x)) ; }
#define OUTPUT1(a,x) for(i = 0; i < n; i++) { a ; printf("%g\n", x) ; }
#define OUTPUT2(a,x,y) for(i = 0; i < n; i++) { a ; printf("%g %g\n", x, y) ; }
#define OUTPUT3(a,x,y,z) for(i = 0; i < n; i++) { a ; printf("%g %g %g\n", x, y, z) ; }
#define INT_OUTPUT(x) for (i = 0; i < n; i++) { printf("%d\n", (x)) ; }
#define ARGS(x,y) if (argc != x) error(y) ;
#define DBL_ARG(x) if (argc) { x=atof((++argv)[0]);argc--;} else {error( #x);};
#define INT_ARG(x) if (argc) { x=atoi((++argv)[0]);argc--;} else {error( #x);};
if (NAME("bernoulli"))
{
ARGS(1, "p = probability of success");
DBL_ARG(p)
INT_OUTPUT(gsl_ran_bernoulli (r, p));
}
else if (NAME("beta"))
{
ARGS(2, "a,b = shape parameters");
DBL_ARG(a)
DBL_ARG(b)
OUTPUT(gsl_ran_beta (r, a, b));
}
else if (NAME("binomial"))
{
ARGS(2, "p = probability, N = number of trials");
DBL_ARG(p)
INT_ARG(N)
INT_OUTPUT(gsl_ran_binomial (r, p, N));
}
else if (NAME("cauchy"))
{
ARGS(1, "a = scale parameter");
DBL_ARG(a)
OUTPUT(gsl_ran_cauchy (r, a));
}
else if (NAME("chisq"))
{
ARGS(1, "nu = degrees of freedom");
DBL_ARG(nu)
OUTPUT(gsl_ran_chisq (r, nu));
}
else if (NAME("erlang"))
{
ARGS(2, "a = scale parameter, b = order");
DBL_ARG(a)
DBL_ARG(b)
OUTPUT(gsl_ran_erlang (r, a, b));
}
else if (NAME("exponential"))
{
ARGS(1, "mu = mean value");
DBL_ARG(mu) ;
OUTPUT(gsl_ran_exponential (r, mu));
}
else if (NAME("exppow"))
{
ARGS(2, "a = scale parameter, b = power (1=exponential, 2=gaussian)");
DBL_ARG(a) ;
DBL_ARG(b) ;
OUTPUT(gsl_ran_exppow (r, a, b));
}
else if (NAME("fdist"))
{
ARGS(2, "nu1, nu2 = degrees of freedom parameters");
DBL_ARG(nu1) ;
DBL_ARG(nu2) ;
OUTPUT(gsl_ran_fdist (r, nu1, nu2));
}
else if (NAME("flat"))
{
ARGS(2, "a = lower limit, b = upper limit");
DBL_ARG(a) ;
DBL_ARG(b) ;
OUTPUT(gsl_ran_flat (r, a, b));
}
else if (NAME("gamma"))
{
ARGS(2, "a = order, b = scale");
DBL_ARG(a) ;
DBL_ARG(b) ;
OUTPUT(gsl_ran_gamma (r, a, b));
}
else if (NAME("gaussian"))
{
ARGS(1, "sigma = standard deviation");
DBL_ARG(sigma) ;
OUTPUT(gsl_ran_gaussian (r, sigma));
}
else if (NAME("gaussian-tail"))
{
ARGS(2, "a = lower limit, sigma = standard deviation");
DBL_ARG(a) ;
DBL_ARG(sigma) ;
OUTPUT(gsl_ran_gaussian_tail (r, a, sigma));
}
else if (NAME("ugaussian"))
{
ARGS(0, "unit gaussian, no parameters required");
OUTPUT(gsl_ran_ugaussian (r));
}
else if (NAME("ugaussian-tail"))
{
ARGS(1, "a = lower limit");
DBL_ARG(a) ;
OUTPUT(gsl_ran_ugaussian_tail (r, a));
}
else if (NAME("bivariate-gaussian"))
{
ARGS(3, "sigmax = x std.dev., sigmay = y std.dev., rho = correlation");
DBL_ARG(sigmax) ;
DBL_ARG(sigmay) ;
DBL_ARG(rho) ;
OUTPUT2(gsl_ran_bivariate_gaussian (r, sigmax, sigmay, rho, &x, &y),
x, y);
}
else if (NAME("dir-2d"))
{
OUTPUT2(gsl_ran_dir_2d (r, &x, &y), x, y);
}
else if (NAME("dir-3d"))
{
OUTPUT3(gsl_ran_dir_3d (r, &x, &y, &z), x, y, z);
}
else if (NAME("dir-nd"))
{
double *xarr;
ARGS(1, "n1 = number of dimensions of hypersphere");
INT_ARG(n1) ;
xarr = (double *)malloc(n1*sizeof(double));
for(i = 0; i < n; i++) {
gsl_ran_dir_nd (r, n1, xarr) ;
for (j = 0; j < n1; j++) {
if (j) putchar(' ');
printf("%g", xarr[j]) ;
}
putchar('\n');
} ;
free(xarr);
}
else if (NAME("geometric"))
{
ARGS(1, "p = bernoulli trial probability of success");
DBL_ARG(p) ;
INT_OUTPUT(gsl_ran_geometric (r, p));
}
else if (NAME("gumbel1"))
{
ARGS(2, "a = order, b = scale parameter");
DBL_ARG(a) ;
DBL_ARG(b) ;
OUTPUT(gsl_ran_gumbel1 (r, a, b));
}
else if (NAME("gumbel2"))
{
ARGS(2, "a = order, b = scale parameter");
DBL_ARG(a) ;
DBL_ARG(b) ;
OUTPUT(gsl_ran_gumbel2 (r, a, b));
}
else if (NAME("hypergeometric"))
{
ARGS(3, "n1 = tagged population, n2 = untagged population, t = number of trials");
INT_ARG(n1) ;
INT_ARG(n2) ;
INT_ARG(t) ;
INT_OUTPUT(gsl_ran_hypergeometric (r, n1, n2, t));
}
else if (NAME("laplace"))
{
ARGS(1, "a = scale parameter");
DBL_ARG(a) ;
OUTPUT(gsl_ran_laplace (r, a));
}
else if (NAME("landau"))
{
ARGS(0, "no arguments required");
OUTPUT(gsl_ran_landau (r));
}
else if (NAME("levy"))
{
ARGS(2, "c = scale, a = power (1=cauchy, 2=gaussian)");
DBL_ARG(c) ;
DBL_ARG(a) ;
OUTPUT(gsl_ran_levy (r, c, a));
}
else if (NAME("levy-skew"))
{
ARGS(3, "c = scale, a = power (1=cauchy, 2=gaussian), b = skew");
DBL_ARG(c) ;
DBL_ARG(a) ;
DBL_ARG(b) ;
OUTPUT(gsl_ran_levy_skew (r, c, a, b));
}
else if (NAME("logarithmic"))
{
ARGS(1, "p = probability");
DBL_ARG(p) ;
INT_OUTPUT(gsl_ran_logarithmic (r, p));
}
else if (NAME("logistic"))
{
ARGS(1, "a = scale parameter");
DBL_ARG(a) ;
OUTPUT(gsl_ran_logistic (r, a));
}
else if (NAME("lognormal"))
{
ARGS(2, "zeta = location parameter, sigma = scale parameter");
DBL_ARG(zeta) ;
DBL_ARG(sigma) ;
OUTPUT(gsl_ran_lognormal (r, zeta, sigma));
}
else if (NAME("negative-binomial"))
{
ARGS(2, "p = probability, a = order");
DBL_ARG(p) ;
DBL_ARG(a) ;
INT_OUTPUT(gsl_ran_negative_binomial (r, p, a));
}
else if (NAME("pareto"))
{
ARGS(2, "a = power, b = scale parameter");
DBL_ARG(a) ;
DBL_ARG(b) ;
OUTPUT(gsl_ran_pareto (r, a, b));
}
else if (NAME("pascal"))
{
ARGS(2, "p = probability, n = order (integer)");
DBL_ARG(p) ;
INT_ARG(N) ;
INT_OUTPUT(gsl_ran_pascal (r, p, N));
}
else if (NAME("poisson"))
{
ARGS(1, "mu = scale parameter");
DBL_ARG(mu) ;
INT_OUTPUT(gsl_ran_poisson (r, mu));
}
else if (NAME("rayleigh"))
{
ARGS(1, "sigma = scale parameter");
DBL_ARG(sigma) ;
OUTPUT(gsl_ran_rayleigh (r, sigma));
}
else if (NAME("rayleigh-tail"))
{
ARGS(2, "a = lower limit, sigma = scale parameter");
DBL_ARG(a) ;
DBL_ARG(sigma) ;
OUTPUT(gsl_ran_rayleigh_tail (r, a, sigma));
}
else if (NAME("tdist"))
{
ARGS(1, "nu = degrees of freedom");
DBL_ARG(nu) ;
OUTPUT(gsl_ran_tdist (r, nu));
}
else if (NAME("weibull"))
{
ARGS(2, "a = scale parameter, b = exponent");
DBL_ARG(a) ;
DBL_ARG(b) ;
OUTPUT(gsl_ran_weibull (r, a, b));
}
else
{
fprintf(stderr,"Error: unrecognized distribution: %s\n", name) ;
}
return 0 ;
}
int GlmTest::resampNonCase(glm *model, gsl_matrix *bT, unsigned int i)
{
unsigned int j, k, id;
double bt, score, yij, mij;
gsl_vector_view yj;
unsigned int nRows=tm->nRows, nVars=tm->nVars;
// note that residuals have got means subtracted
switch (tm->resamp) {
case RESIBOOT:
if (tm->reprand!=TRUE) GetRNGstate();
for (j=0; j<nRows; j++) {
if (bootID!=NULL)
id = (unsigned int) gsl_matrix_get(bootID, i, j);
else if (tm->reprand==TRUE)
id = (unsigned int) gsl_rng_uniform_int(rnd, nRows);
else id = (unsigned int) nRows * Rf_runif(0, 1);
// bY = mu+(bootr*sqrt(variance))
for (k=0; k<nVars; k++) {
bt=gsl_matrix_get(model->Mu,j,k)+sqrt(gsl_matrix_get(model->Var,j,k))*gsl_matrix_get(model->Res, id, k);
bt = MAX(bt, 0.0);
bt = MIN(bt, model->maxtol);
gsl_matrix_set(bT, j, k, bt);
} }
if (tm->reprand!=TRUE) PutRNGstate();
break;
case SCOREBOOT:
for (j=0; j<nRows; j++) {
if (bootID!=NULL)
score = (double) gsl_matrix_get(bootID, i, j);
else if (tm->reprand==TRUE)
score = gsl_ran_ugaussian (rnd);
else score = Rf_rnorm(0.0, 1.0);
// bY = mu + score*sqrt(variance)
for (k=0; k<nVars; k++){
bt=gsl_matrix_get(model->Mu, j, k)+sqrt(gsl_matrix_get(model->Var, j, k))*gsl_matrix_get(model->Res, j, k)*score;
bt = MAX(bt, 0.0);
bt = MIN(bt, model->maxtol);
gsl_matrix_set(bT, j, k, bt);
} }
break;
case PERMUTE:
if (bootID==NULL)
gsl_ran_shuffle(rnd,permid,nRows,sizeof(unsigned int));
for (j=0; j<nRows; j++) {
if (bootID==NULL) id = permid[j];
else id = (unsigned int) gsl_matrix_get(bootID, i, j);
// bY = mu + bootr * sqrt(var)
for (k=0; k<nVars; k++) {
bt=gsl_matrix_get(model->Mu,j,k)+sqrt(gsl_matrix_get(model->Var,j,k))*gsl_matrix_get(model->Res, id, k);
bt = MAX(bt, 0.0);
bt = MIN(bt, model->maxtol);
gsl_matrix_set(bT, j, k, bt);
} }
break;
case FREEPERM:
if (bootID==NULL)
gsl_ran_shuffle(rnd,permid,nRows,sizeof(unsigned int));
for (j=0; j<nRows; j++) {
if (bootID==NULL) id = permid[j];
else id = (unsigned int) gsl_matrix_get(bootID, i, j);
yj=gsl_matrix_row(model->Yref, id);
gsl_matrix_set_row (bT, j, &yj.vector);
}
break;
case MONTECARLO:
McSample(model, rnd, XBeta, Sigma, bT);
break;
case PITSBOOT:
if (tm->reprand!=TRUE) GetRNGstate();
for (j=0; j<nRows; j++) {
if (bootID!=NULL)
id = (unsigned int) gsl_matrix_get(bootID, i, j);
else if (tm->reprand==TRUE)
id = (unsigned int) gsl_rng_uniform_int(rnd, nRows);
else id = (unsigned int) Rf_runif(0, nRows);
for (k=0; k<nVars; k++) {
bt = gsl_matrix_get(model->PitRes, id, k);
mij = gsl_matrix_get(model->Mu, j, k);
yij = model->cdfinv(bt, mij, model->theta[k]);
gsl_matrix_set(bT, j, k, yij);
}
}
if (tm->reprand!=TRUE) PutRNGstate();
break;
default: GSL_ERROR("The resampling method is not supported", GSL_ERANGE); break;
}
return SUCCESS;
}
int main(int argc, char **argv) {
gsl_rng *rng;
gsl_rng_env_setup();
const gsl_rng_type *rngType = gsl_rng_default;
rng = gsl_rng_alloc(rngType);
const size_t M = SIZE1;
const size_t N = SIZE2;
gsl_matrix *A = gsl_matrix_alloc(M, N);
int i = 0;
int j = 0;
int sigNum = 0;
for (i = 0; i < M; i++) {
for (j = 0; j < N; j++) {
gsl_matrix_set(A, i, j, gsl_ran_ugaussian(rng));
}
}
gsl_matrix *B = gsl_matrix_alloc(M, N);
gsl_matrix_memcpy(B, A);
gsl_matrix *C = gsl_matrix_alloc(M, N);
gsl_blas_dgemm(CblasNoTrans, CblasTrans, 1.0, A, B, 0.0, C);
gsl_matrix *D = gsl_matrix_alloc(M, N);
gsl_matrix_memcpy(D, C); // will be used in QTQ' decompostion
gsl_linalg_cholesky_decomp(C);
printf("%e\n", gsl_matrix_get(C, M/2, N/2));
gsl_matrix_free(B);
gsl_matrix *A1 = gsl_matrix_alloc(M, N);
gsl_matrix_memcpy(A1, A);
gsl_permutation *P = gsl_permutation_alloc(M); // will be used in
// other cases
gsl_permutation_init(P);
gsl_ran_shuffle (rng, P->data, M, sizeof(size_t));
gsl_linalg_LU_decomp(A1, P, &sigNum);
printf("%e\n", gsl_matrix_get(A1, M/2, N/2));
gsl_matrix *A2 = gsl_matrix_alloc(M, N);
gsl_matrix_memcpy(A2, A);
gsl_vector *tau = gsl_vector_alloc(GSL_MIN(M, N));
gsl_linalg_QR_decomp(A2, tau);
printf("%e\n", gsl_matrix_get(A2, M/2, N/2));
gsl_vector_free(tau);
gsl_matrix *A3 = gsl_matrix_alloc(M, N);
gsl_matrix_memcpy(A3, A);
gsl_matrix *svdV = gsl_matrix_alloc(N, N);
gsl_vector *svdS = gsl_vector_alloc(N);
gsl_vector *svdWorkspace = gsl_vector_alloc(N);
gsl_linalg_SV_decomp(A3, svdV, svdS, svdWorkspace);
printf("%e\n", gsl_vector_get(svdS, N/2));
gsl_vector *tau2 = gsl_vector_alloc(N - 1);
gsl_linalg_symmtd_decomp(D, tau2);
printf("%e\n", gsl_matrix_get(D, N/2, N/2));
return 0;
}
int AnovaTest::resampTest(void)
{
// printf("Start resampling test ...\n");
unsigned int i, j, p, id;
unsigned int maxiter=mmRef->nboot;
double hii, score;
gsl_matrix *bX, *bY;
bY = gsl_matrix_alloc(nRows, nVars);
bX = gsl_matrix_alloc(nRows, nParam);
// initialize permid
unsigned int *permid=NULL;
if ( bootID == NULL ) {
if ( mmRef->resamp == PERMUTE ){
permid = (unsigned int *)malloc(nRows*sizeof(unsigned int));
for (i=0; i<nRows; i++)
permid[i] = i;
} }
// else
// displaymatrix(bootID, "bootID received");
// resampling options
if (mmRef->resamp == CASEBOOT) {
nSamp = 0;
for (i=0; i<maxiter; i++) {
for ( j=0; j<nRows; j++ ){
// resampling index
if (bootID == NULL)
id = gsl_rng_uniform_int(rnd, nRows);
else
id = (unsigned int) gsl_matrix_get(bootID, i, j);
// resample Y and X
gsl_vector_view Yj=gsl_matrix_row(Yref, id);
gsl_matrix_set_row (bY, j, &Yj.vector);
gsl_vector_view Xj=gsl_matrix_row(Xref, id);
gsl_matrix_set_row (bX, j, &Xj.vector);
}
anovacase(bY, bX);
nSamp++;
}
}
else if (mmRef->resamp == RESIBOOT) {
nSamp = 0;
for (i=0; i<maxiter; i++) {
for (p=1; p<nModels; p++) {
if (mmRef->reprand!=TRUE) {
GetRNGstate();
printf("reprand==FALSE\n");
}
for (j=0; j<nRows; j++){
// resampling index
if (bootID == NULL)
id = gsl_rng_uniform_int(rnd, nRows);
else
id = (unsigned int) gsl_matrix_get(bootID, i, j);
// bootr by resampling resi=(Y-fit)
gsl_vector_view Yj=gsl_matrix_row(Yref, id);
gsl_vector_view Fj=gsl_matrix_row(Hats[p].Y, id);
gsl_matrix_set_row (bY, j, &Yj.vector);
gsl_vector_view bootr=gsl_matrix_row(bY, j);
gsl_vector_sub (&bootr.vector, &Fj.vector);
if (mmRef->student==TRUE) {
hii = gsl_matrix_get(Hats[p].mat, id, id);
gsl_vector_scale (&bootr.vector, 1/sqrt(1-hii));
}
// bY = Y + bootr
Yj=gsl_matrix_row(Hats[p].Y, j);
gsl_vector_add (&bootr.vector, &Yj.vector);
}
if (mmRef->reprand!=TRUE) PutRNGstate();
anovaresi(bY, p);
}
nSamp++;
} }
else if (mmRef->resamp == SCOREBOOT) {
nSamp = 0;
for (i=0; i<maxiter; i++) {
for (p=1; p<nModels; p++) {
for ( j=0; j<nRows; j++ ) {
// random score
if ( bootID == NULL )
score = gsl_ran_ugaussian (rnd);
else
score = (double)gsl_matrix_get(bootID, i, j);
// bootr = (Y - fit)*score
gsl_vector_view Yj=gsl_matrix_row(Yref, j);
gsl_vector_view Fj=gsl_matrix_row(Hats[p].Y, j);
gsl_matrix_set_row (bY, j, &Yj.vector);
gsl_vector_view bootr=gsl_matrix_row(bY, j);
gsl_vector_sub (&bootr.vector, &Fj.vector);
if (mmRef->student==TRUE) {
hii = gsl_matrix_get(Hats[p].mat, j, j);
gsl_vector_scale (&bootr.vector, 1/sqrt(1-hii));
}
// bY = Y + bootr
gsl_vector_scale (&bootr.vector, score);
gsl_vector_add (&bootr.vector, &Fj.vector);
}
anovaresi(bY, p);
}
nSamp++;
} }
else if ( mmRef->resamp == PERMUTE ) {
gsl_matrix_add_constant (Pstatj, 1.0);
for (p=0; p<nModels-1; p++)
Pmultstat[p]=1.0; // include itself
nSamp = 1;
for (i=0; i<maxiter-1; i++) { //999
for (p=1; p<nModels; p++){
if (bootID == NULL )
gsl_ran_shuffle(rnd, permid, nRows, sizeof(unsigned int));
// get bootr by permuting resi:Y-fit
for (j=0; j<nRows; j++){
if (bootID == NULL)
id = permid[j];
else
id = (unsigned int) gsl_matrix_get(bootID, i, j);
// bootr by resampling resi=(Y-fit)
gsl_vector_view Yj=gsl_matrix_row(Yref, id);
gsl_vector_view Fj=gsl_matrix_row(Hats[p].Y, id);
gsl_matrix_set_row (bY, j, &Yj.vector);
gsl_vector_view bootr=gsl_matrix_row(bY, j);
gsl_vector_sub (&bootr.vector, &Fj.vector);
if (mmRef->student==TRUE) {
hii = gsl_matrix_get(Hats[p].mat, id, id);
gsl_vector_scale (&bootr.vector, 1/sqrt(1-hii));
}
// bY = Y + bootr
Yj=gsl_matrix_row(Hats[p].Y, j);
gsl_vector_add (&bootr.vector, &Yj.vector);
}
anovaresi(bY, p);
}
nSamp++;
}
}
else
GSL_ERROR("Invalid resampling option", GSL_EINVAL);
// p-values
unsigned int sid, sid0;
double *pj;
for (i=0; i<nModels-1; i++) {
Pmultstat[i]=(double) (Pmultstat[i]+1)/(nSamp+1); // adjusted with +1
pj = gsl_matrix_ptr (Pstatj, i, 0);
if ( mmRef->punit == FREESTEP ){
for (j=1; j<nVars; j++){
sid = gsl_permutation_get(sortid[i], j);
sid0 = gsl_permutation_get(sortid[i], j-1);
*(pj+sid)=MAX(*(pj+sid), *(pj+sid0));
}
}
if ( mmRef->punit == STEPUP ){
for (j=2; j<nVars; j++){
sid = gsl_permutation_get(sortid[i], nVars-j);
sid0 = gsl_permutation_get(sortid[i], nVars-j+1);
*(pj+sid) = MIN(*(pj+sid), *(pj+sid0));
}
}
for (j=0; j<nVars; j++)
*(pj+j) = (double)(*(pj+j)+1)/(nSamp+1); // adjusted with +1
}
// free memory
gsl_matrix_free(bX);
gsl_matrix_free(bY);
if (permid!=NULL) free(permid);
return 0;
}
bool apply(LociData & d)
{
d.set_param("phenotype", (gsl_ran_ugaussian(d.rng()) + d.info("loci_meanshift")));
return true;
}
double
test_ugaussian (void)
{
return gsl_ran_ugaussian (r_global);
}
void SampleNormedRndVecWBias(gsl_vector* opinion, double x, gsl_rng * r)
{
for (size_t i = 0; i < opinion->size ; i++)
gsl_vector_set(opinion,i, x + gsl_ran_ugaussian(r) );
NormalizeGslVector(opinion);
}
/* Draw one sample from the Markov Chain using the RMHMC algorithm.
* Arguments:
* kernel: a pointer to the RMHMC kernel data structure.
* Result:
* returns zero for success and non-zero for failure.
* the new sample is directly updated in kernel->x.
* acc is set to 0 if the chain in the previous state (reject)
* and 1 if the chain made a transition to a new state (accept)
*/
static int rmhmc_kernel_sample(mcmc_kernel* kernel, int* acc){
rmhmc_params* state = (rmhmc_params*) kernel->kernel_params;
rmhmc_model* model = (rmhmc_model*) kernel->model_function;
gsl_rng* rng = (gsl_rng*) kernel->rng;
int N = kernel->N;
double stepSize = state->stepsize;
int fIt = state->fIt;
/* sample momentum variables from multivariate normal with covariance Mx */
double* p = state->momentum;
int d;
for (d = 0; d < N; d++)
p[d] = gsl_ran_ugaussian(rng);
gsl_vector_view p_v = gsl_vector_view_array(state->momentum, N);
gsl_matrix_view cholM_v = gsl_matrix_view_array(state->cholMx, N, N);
/* p = cholM*p */
gsl_blas_dtrmv (CblasUpper, CblasTrans, CblasNonUnit, &cholM_v.matrix, &p_v.vector);
/* randomise direction of integration */
double randDir = gsl_rng_uniform(rng);
if (randDir > 0.5)
stepSize = -1.0*stepSize;
/* randomise number of leap-frog steps */
int L = 1 + gsl_rng_uniform_int(rng, state->mL);
/* Generalised leap-frog integrator */
copyStateVariables(state, kernel);
gsl_vector_view new_p_v = gsl_vector_view_array(state->new_momentum, N);
gsl_vector_view tmpVect = gsl_vector_view_array(state->p0, N);
int l;
int flag = 0;
for (l = 0; l < L; l++) {
/* momentum Newton update */
/* temp copy of momentum variables */
gsl_vector_memcpy(&tmpVect.vector, &new_p_v.vector);
momentumNewtonUpdate(state, state->p0, fIt, N, stepSize);
/* parameters Newton update */
flag = parametersNewtonUpdate(state, model, N, stepSize);
if (flag != 0){
fprintf(stderr,"RMHMC: Error in parameter Newton update. Reject step.\n");
*acc = 0;
return flag;
}
/* single Newton update step for momentum variables */
momentumNewtonUpdate(state, state->new_momentum, 1, N, stepSize);
}
/* calculate Hamiltonian energy for current state */
double H_c = calculateHamiltonian(N, state->fx, state->cholMx, state->invMx, state->momentum, state);
/* calculate Hamiltonian energy for proposed state */
double H_p = calculateHamiltonian(N, state->new_fx, state->new_cholMx, state->new_invMx, state->new_momentum, state);
/* Accept/reject using Metropolis-Hastings ratio */
double mh_ratio = H_p - H_c;
double rand_dec = log(gsl_rng_uniform(rng));
if ( (mh_ratio > 0.0)||(mh_ratio > rand_dec) ) {
*acc = 1;
double* tmp;
SWAP(kernel->x, state->new_x, tmp);
SWAP(state->dfx, state->new_dfx, tmp);
SWAP(state->cholMx, state->new_cholMx, tmp);
SWAP(state->invMx, state->new_invMx, tmp);
SWAP(state->dMx, state->new_dMx, tmp);
state->fx = state->new_fx;
}else {
*acc = 0;
}
return 0;
}
